PDA

View Full Version : Solved: Convert row into multiple rows of data (ARRAYS)



dek
04-20-2009, 05:46 AM
Convert row into multiple rows of data (ARRAYS)
Hi,

I have not had a reply to my post, and considered that this may be because it has been flagged as solved or because a reply is not populating the forum. Nevertheless, I attach the situation below:

Change of Scope
I wish I put a bit more consideration in before submitting and having absorbed your time. Unfortunately, I have one last (i promise) change to the scope. Would you assist again?

Additional Contacts
A new column of "Outlook Contacts" (which is a master list of contacts from Outlook) has been inserted with a ";" as a separator.

Unchanged
The original Attendee columns (from 1 - 10) and respective elements to the Attendee (Company and Channel) are unchanged.

The "Atttendees Required" is unchanged in format.

Overall Goal
The end goal is unchanged in that each "Attendee Required" needs the "Attendees" and "Outlook Contacts" to be populated with respective elements (i.e Company and Channel).

The "Outlook Contacts" company and channel information is in a separate sheet named "Master List".

Please see the "Goal" section of the sample file attached.

dek

mdmackillop
04-21-2009, 12:34 PM
Please don't complicate examples with unnecessary Forms. They just get in the way. Get your solution first, and prettify it later.

Option Explicit
Sub CommandButton1_Click()
Dim rng As Range
Dim tgt As Range
Dim cel As Range
Dim Srce As Range
Dim Nmes, n
Dim att As String, Com As String, Chan As String
Dim Col As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim OContact, O


Application.ScreenUpdating = False
Set ws1 = Sheets("Data") '<======= Change to suit. or maybe ActiveSheet
On Error Resume Next
Set ws2 = Sheets("Output")
If ws2 Is Nothing Then
Set ws2 = Sheets.Add
ws2.Name = "Output"
End If
On Error GoTo 0

ws2.Range("A1:F1") = Array("Ref", "Attendee", "Company", "Attendees Required", "Subject", "Date Start")
ws2.Range("A1:F1").Font.Bold = True
ws2.Columns(6).NumberFormat = "dd/mm/yy"
With ws1
.Activate
Set rng = Range(.Cells(5, 4), .Cells(Rows.Count, 4).End(xlUp))
For Each cel In rng
For Col = 6 To 32 Step 3
If .Cells(cel.Row, Col) <> "" Then
att = .Cells(cel.Row, Col)
Com = .Cells(cel.Row, Col + 1)
Chan = .Cells(cel.Row, Col + 2)

Set Srce = .Cells(cel.Row, 1)

Nmes = Split(cel, ";")
For Each n In Nmes
Set tgt = ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
tgt.Offset(, 0) = Srce.Offset(, 0)
tgt.Offset(, 1) = Srce.Offset(, 1)
tgt.Offset(, 2) = Srce.Offset(, 2)
tgt.Offset(, 3) = Trim(n)
tgt.Offset(, 4) = att
tgt.Offset(, 5) = Com
tgt.Offset(, 6) = Srce.Offset(, 23)

OContact = Split(cel.Offset(, 1), ";")
For Each O In OContact
Set tgt = ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
tgt.Offset(, 0) = Srce.Offset(, 0)
tgt.Offset(, 1) = Srce.Offset(, 1)
tgt.Offset(, 2) = Srce.Offset(, 2)
tgt.Offset(, 3) = Trim(O)
tgt.Offset(, 4).FormulaR1C1 = "=VLOOKUP(RC4,'Master List'!C1:C3,2,FALSE)"
tgt.Offset(, 5).FormulaR1C1 = "=VLOOKUP(RC4,'Master List'!C1:C3,3,FALSE)"
Next
Next

End If
Next
Next
End With
Application.ScreenUpdating = True
Unload Form
End Sub

dek
04-22-2009, 03:36 AM
Hi,

Overview
I have downloaded the solution code and workbook and ran the code. It did not generate the "output" expected.

Amended Solution Code
The solution code has been amended and marked up for my understanding. The code now generates the following result

RefDateSubjectAttendeeInhouse StaffCompanyChannelExcel Row14/16/2009ABCSteve LeeLong, BenABCmedia114/16/2009ABCWill SmithLong, BenPro SolutionsFinance214/16/2009ABCPamela AndersonLong, BenGoogleMedia314/16/2009ABCJohn HughesLong, BenYahooMedia414/16/2009ABCPeter KyteLong, BenNABFinance514/16/2009ABCSteve LeeShort, PeterABCmedia614/16/2009ABCWill SmithShort, PeterPro SolutionsFinance714/16/2009ABCPamela AndersonShort, PeterGoogleMedia814/16/2009ABCJohn HughesShort, PeterYahooMedia914/16/2009ABCPeter KyteShort, PeterNABFinance1014/16/2009ABCGill SpatLong, BenDEFfinance[move to row 1]1114/16/2009ABCWill SmithLong, BenPro SolutionsFinance[not required]1214/16/2009ABCPamela AndersonLong, BenGoogleMedia[not required]1314/16/2009ABCJohn HughesLong, BenYahooMedia[not required]1414/16/2009ABCPeter KyteLong, BenNABFinance[not required]1514/16/2009ABCGill SpatShort, PeterDEFfinance[move into row 7]1614/16/2009ABCWill SmithShort, PeterPro SolutionsFinance[not required]1714/16/2009ABCPamela AndersonShort, PeterGoogleMedia[not required]1814/16/2009ABCJohn HughesShort, PeterYahooMedia[not required]1914/16/2009ABCPeter KyteShort, PeterNABFinance[not required]20

Issue
Currently the code (see markup in code => DEK) loops based on the count of Outlook contacts.

The code should be counting the Inhouse Attendees instead and applying each Outlook contact to the Inhouse Attendee.

I have spent time trying to achieve this without success.

Option Explicit
Sub CommandButton1_Click()
Dim rng As Range
Dim tgt As Range
Dim cel As Range
Dim Srce As Range
Dim Nmes, n
Dim att As String, Com As String, Chan As String
Dim Col As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim OContact, O


Application.ScreenUpdating = False
'Set the Data sheet as the source sheet
Set ws1 = Sheets("Data") '<======= Change to suit. or maybe ActiveSheet
On Error Resume Next
'Establish the Output sheet if it does not exist
Set ws2 = Sheets("Output")
If ws2 Is Nothing Then
Set ws2 = Sheets.Add
ws2.Name = "Output"
End If
On Error GoTo 0

'Establish the range of output with headings and formats
ws2.Range("A1:G1") = Array("Ref", "Date", "Subject", "Attendee", "Inhouse Staff", "Company", "Channel")
ws2.Range("A1:G1").Font.Bold = True
ws2.Columns(2).NumberFormat = "dd/mm/yy"

'Activate Data sheet
With ws1
.Activate

'Set range at Row 6, Column 4 to end of row count to Column 4
Set rng = Range(.Cells(6, 4), .Cells(Rows.Count, 4).End(xlUp))

'Loop process
For Each cel In rng

'Count populated fields between columns 6 and 32 with an interval of 3 columns
For Col = 6 To 32 Step 3
'For columns [6-32] that have a value
If .Cells(cel.Row, Col) <> "" Then
att = .Cells(cel.Row, Col)
Com = .Cells(cel.Row, Col + 1)
Chan = .Cells(cel.Row, Col + 2)

'Define column 1 to be reference
Set Srce = .Cells(cel.Row, 1)

'Separate the Attendee 1 - 10 with details and allocate to the inhouse staff member
Nmes = Split(cel, ";") 'Declare variable as Nmes
For Each n In Nmes 'Loop through each instance
Set tgt = ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
tgt.Offset(, 0) = Srce.Offset(, 0) 'Reference
tgt.Offset(, 1) = Srce.Offset(, 1) 'Date Start
tgt.Offset(, 2) = Srce.Offset(, 2) 'Subject
tgt.Offset(, 4) = Trim(n) 'In house Attendee
tgt.Offset(, 3) = att 'External Contact Attendee
tgt.Offset(, 5) = Com 'Company
tgt.Offset(, 6) = Chan 'Channel

' => DEK Loop process should only continue for the number of inhouse attendees as declared in Nmes
OContact = Split(cel.Offset(, 1), ";")
For Each O In OContact
Set tgt = ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
tgt.Offset(, 0) = Srce.Offset(, 0) 'Reference
tgt.Offset(, 1) = Srce.Offset(, 1) 'Date Start
tgt.Offset(, 2) = Srce.Offset(, 2) 'Subject
tgt.Offset(, 4) = Trim(n) 'In house Attendee [Required for each external outlook Attendee]
tgt.Offset(, 3) = Trim(O) 'External Outlook Attendee
tgt.Offset(, 5).FormulaR1C1 = "=VLOOKUP(RC4,'Master List'!C1:C3,2,FALSE)" 'External Attendee Company
tgt.Offset(, 6).FormulaR1C1 = "=VLOOKUP(RC4,'Master List'!C1:C3,3,FALSE)" 'External Attendee Chanel
Next
Next
End If
Next
Next
End With
Application.ScreenUpdating = True
Unload Form
End Sub

dek

dek
04-22-2009, 03:39 AM
Attached workbook as the "Output" in the post below is not structured

Also, repeat the code as it does not look pretty

Option Explicit
Sub CommandButton1_Click()
Dim rng As Range
Dim tgt As Range
Dim cel As Range
Dim Srce As Range
Dim Nmes, n
Dim att As String, Com As String, Chan As String
Dim Col As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim OContact, O


Application.ScreenUpdating = False
'Set the Data sheet as the source sheet
Set ws1 = Sheets("Data") '<======= Change to suit. or maybe ActiveSheet
On Error Resume Next
'Establish the Output sheet if it does not exist
Set ws2 = Sheets("Output")
If ws2 Is Nothing Then
Set ws2 = Sheets.Add
ws2.Name = "Output"
End If
On Error GoTo 0

'Establish the range of output with headings and formats
ws2.Range("A1:G1") = Array("Ref", "Date", "Subject", "Attendee", "Inhouse Staff", "Company", "Channel")
ws2.Range("A1:G1").Font.Bold = True
ws2.Columns(2).NumberFormat = "dd/mm/yy"

'Activate Data sheet
With ws1
.Activate

'Set range at Row 6, Column 4 to end of row count to Column 4
Set rng = Range(.Cells(6, 4), .Cells(Rows.Count, 4).End(xlUp))

'Loop process
For Each cel In rng

'Count populated fields between columns 6 and 32 with an interval of 3 columns
For Col = 6 To 32 Step 3
'For columns [6-32] that have a value
If .Cells(cel.Row, Col) <> "" Then
att = .Cells(cel.Row, Col)
Com = .Cells(cel.Row, Col + 1)
Chan = .Cells(cel.Row, Col + 2)

'Define column 1 to be reference
Set Srce = .Cells(cel.Row, 1)

'Separate the Attendee 1 - 10 with details and allocate to the inhouse staff member
Nmes = Split(cel, ";") 'Declare variable as Nmes
For Each n In Nmes 'Loop through each instance
Set tgt = ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
tgt.Offset(, 0) = Srce.Offset(, 0) 'Reference
tgt.Offset(, 1) = Srce.Offset(, 1) 'Date Start
tgt.Offset(, 2) = Srce.Offset(, 2) 'Subject
tgt.Offset(, 4) = Trim(n) 'In house Attendee
tgt.Offset(, 3) = att 'External Contact Attendee
tgt.Offset(, 5) = Com 'Company
tgt.Offset(, 6) = Chan 'Channel

' => DEK Loop process should only continue for the number of inhouse attendees as declared in Nmes
OContact = Split(cel.Offset(, 1), ";")
For Each O In OContact
Set tgt = ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
tgt.Offset(, 0) = Srce.Offset(, 0) 'Reference
tgt.Offset(, 1) = Srce.Offset(, 1) 'Date Start
tgt.Offset(, 2) = Srce.Offset(, 2) 'Subject
tgt.Offset(, 4) = Trim(n) 'In house Attendee [Required for each external outlook Attendee]
tgt.Offset(, 3) = Trim(O) 'External Outlook Attendee
tgt.Offset(, 5).FormulaR1C1 = "=VLOOKUP(RC4,'Master List'!C1:C3,2,FALSE)" 'External Attendee Company
tgt.Offset(, 6).FormulaR1C1 = "=VLOOKUP(RC4,'Master List'!C1:C3,3,FALSE)" 'External Attendee Chanel
Next
Next
End If
Next
Next
End With
Application.ScreenUpdating = True
Unload Form
End Sub

mdmackillop
04-22-2009, 04:38 AM
Glad you got it sorted out (and can follow what is happening!)

dek
04-22-2009, 07:19 AM
Sorry for the misunderstanding,

The issue still exists and is not resolved.

mdmackillop
04-22-2009, 02:47 PM
I think you can see the basic methodology. Try changing the looping to suit your required output.

dek
04-22-2009, 11:54 PM
I understand where the problem is and have spent hours trying to get code in that works, but always get a different error.

I do not understand the syntax at the moment to correct the error. Your assistance would be greatly appreciated.

mdmackillop
04-23-2009, 09:21 AM
Option Explicit
Sub CommandButton1_Click()
Dim rng As Range
Dim tgt As Range
Dim cel As Range
Dim Srce As Range
Dim Nmes, n
Dim att As String, Com As String, Chan As String
Dim Col As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim OContact, O

Application.ScreenUpdating = False
Set ws1 = Sheets("Data") '<======= Change to suit. or maybe ActiveSheet
On Error Resume Next
Set ws2 = Sheets("Output")
If ws2 Is Nothing Then
Set ws2 = Sheets.Add
ws2.Name = "Output"
End If
On Error GoTo 0

ws2.Range("A1:F1") = Array("Ref", "Date", "Subject", "Attendees Required", "Attendees", "Company", "Channel")
ws2.Range("A1:F1").Font.Bold = True
ws2.Columns(6).NumberFormat = "dd/mm/yy"
With ws1
.Activate
Set rng = Range(.Cells(5, 4), .Cells(Rows.Count, 4).End(xlUp))
For Each cel In rng
Set Srce = .Cells(cel.Row, 1)
Nmes = Split(cel, ";")
For Each n In Nmes

OContact = Split(cel.Offset(, 1), ";")
For Each O In OContact
Set tgt = ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
tgt.Offset(, 0) = Srce.Offset(, 0)
tgt.Offset(, 1) = Srce.Offset(, 1)
tgt.Offset(, 2) = Srce.Offset(, 2)
tgt.Offset(, 3) = Trim(n)
tgt.Offset(, 4) = Trim(O)
tgt.Offset(, 5).FormulaR1C1 = "=VLOOKUP(RC5,'Master List'!C1:C3,2,FALSE)"
tgt.Offset(, 6).FormulaR1C1 = "=VLOOKUP(RC5,'Master List'!C1:C3,3,FALSE)"
Next
For Col = 6 To 32 Step 3
If .Cells(cel.Row, Col) <> "" Then
att = .Cells(cel.Row, Col)
Com = .Cells(cel.Row, Col + 1)
Chan = .Cells(cel.Row, Col + 2)
Set tgt = ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
tgt.Offset(, 0) = Srce.Offset(, 0)
tgt.Offset(, 1) = Srce.Offset(, 1)
tgt.Offset(, 2) = Srce.Offset(, 2)
tgt.Offset(, 3) = Trim(n)
tgt.Offset(, 4) = att
tgt.Offset(, 5) = Com
tgt.Offset(, 6) = Chan
End If
Next
Next
Next
End With
Application.ScreenUpdating = True
Unload Form
End Sub

dek
05-22-2009, 03:29 AM
Just wanted to say thanks again. Apologies for the delayed response. The issue is now closed