Writing a sub, using arrays, to join information on two worksheets using VBA

[Val911]

Hi guys,

I am currently trying to write a sub, using arrays, to join information on two separate worksheets within same workbook. The first worksheet contains two columns with CD labels indexed as such:


Label ID
Name



1
Sony Classical


2
RCA Victor


3
Deutche Grammophone



The second worksheet shows for each label the composer and the piece(s) on the CD as such:




Label ID
Composer
Piece(s)


3
Beethoven
Symphonies, Nos. 4, 7


3
Beethoven
Symphonies, Nos. 5, 8


9
Beethoven
Symphony No. 3







Thus, the tables on these two worksheets are related through the label indexes. I am trying to join this information for each CD on a separate worksheet which would show the music label (its name, not its index), the composer, and the piece(s) as such:



Label name
Composer
Piece(s)


Deutche Grammophone
Beethoven
Symphonies, Nos. 4, 7


Deutche Grammophone
Beethoven
Symphonies, Nos. 5, 8



I am assuming I would need to Dim three different arrays (one for labels and names, one for lables and composers, and one for the joint info) such as this: Dim list1() As String, list2() As String, list3() As String, but how would I combine list1 and list2 into list 3? Would I use a lookup & a for loop? Please advise.

Your help is much appreciated!

[Yongle]

There are a few ways you could do this. Here is one way using VLookup



Sub JoinTables()


' this macro assumes _
sheet1 values are in columns A & B beginning at A2 _
sheet2 values are in columns A,B,C beginning at A2, _
that there are no blank cells in column A in either sheet

'declare variables
Dim LabelIndex As String, LastRow1 As Long, LastRow2 As Long
'last rows on both sheets 1&2 (assumes there are no blank cells in Column A
LastRow1 = Worksheets("Sheet1").Range("A1").End(xlDown).Row
LastRow2 = Worksheets("Sheet2").Range("A1").End(xlDown).Row
'range to use for VLookup
LabelIndex = "A2:B" & LastRow1
'sort sheet1 before using VLookup (VLookup needs the first column sorting)
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1:A" & LastRow1), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range(LabelIndex)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'copy the data from sheet2 to sheet3
For c = 2 To 3 'columns
For r = 1 To LastRow2
Worksheets("sheet3").Cells(r, c) = Worksheets("sheet2").Cells(r, c)
Next r
Next c
Worksheets("Sheet3").Cells(1, 1).Value = "Label"
'and look up the label name in sheet1
For r = 2 To LastRow2
Worksheets("sheet3").Cells(r, 1).Value = Application.WorksheetFunction.VLookup(Sheet2.Cells(r, 1), Sheet1.Range(LabelIndex), 2, 1)
Next r


End Sub

[Yongle]

Or avoiding VBA

Sheet 1
- Sort Columns A & B so that column A is in ascending order
- Create a named range for the data in columns A & B and give it the name Labelrange
Sheet 2
- Copy Columns B & C and..
Sheet3
- ... paste to same columns (B & C)
- Into cell A2 enter the following formula =VLOOKUP(Sheet2!A2,Book1!Labelrange,2,1)
- Copy that formula down as far as you need

[cal911]

Thank you so much for such a detailed report! I didn't notice you use any arrays in your code, did you?

[Paul_Hossler]

Really not necessary to use VBA and/or arrays for this, but if you want to see how arrays work

Note that assigning a worksheet range's values to a Variant data type creates an array



Option Explicit
Sub MatchLabels()
Dim i As Long, iMatch As Long
Dim vLabel2Name As Variant, vLabel2Music As Variant, vLabels As Variant

vLabel2Name = Worksheets("Label2Name").Cells(1, 1).CurrentRegion.Value
vLabels = Worksheets("Label2Name").Cells(1, 1).CurrentRegion.Columns(1).Value
vLabel2Music = Worksheets("Label2Music").Cells(1, 1).CurrentRegion.Value

For i = LBound(vLabel2Music, 1) + 1 To UBound(vLabel2Music, 1)
iMatch = -1
On Error Resume Next
iMatch = Application.WorksheetFunction.Match(vLabel2Music(i, 1), vLabels, 0)
On Error GoTo 0

If iMatch = -1 Then
vLabel2Music(i, 1) = "Missing"
Else
vLabel2Music(i, 1) = vLabel2Name(iMatch, 2)
End If


Next I
Worksheets("MusicWithNames").Cells(1, 1).Resize(UBound(vLabel2Music, 1), UBound(vLabel2Music, 2)).Value = vLabel2Music

End Sub

[Yongle]

@cal911 @val911 Are you one person with 2 identities or two persons with one problem? :confused:

An alternative solution to @Paul_Hossler but this one also uses arrays
My code is a little more simplistic than Paul's - I am relatively new to the coding game.

This solution creates an array for the index (ie sheet1), copies sheet 2 values into an array, and then replaces Label ID with Label Name and puts the values from the amended array into sheet 3.
It is possible that data has been included on sheet2, but the index is incomplete. The missing data will not affect the vba running but, added at the foot of the code is a check for any missing label IDs or label names in sheet1 - this check creates an array of missing items which it finally dumps to column D of sheet1. The same information is also presented in a message box.





Sub Join_Array()
'declare variables
Dim array_sheet1(), array_sheet3()
Dim array_errors()
Dim LastRow1 As Long, LastRow2 As Long
Dim i As Integer, j As Integer, k As Integer
Dim str_array_errors As String
'how many rows on sheets 1 & 2
LastRow1 = Worksheets("Sheet1").Range("A1").End(xlDown).Row
LastRow2 = Worksheets("Sheet2").Range("A1").End(xlDown).Row
'now we know the size of each array
ReDim array_sheet1(LastRow1 - 2, 1)
ReDim array_sheet3(LastRow2 - 2, 2)
ReDim array_errors(LastRow2 - 2, 0)
'create the array for sheet1
For i = 0 To LastRow1 - 2
array_sheet1(i, 0) = Sheet1.Range("A" & i + 2)
array_sheet1(i, 1) = Sheet1.Range("B" & i + 2)
Next i
'create the array for sheet3 based on values in sheet2
For i = 0 To LastRow2 - 2
array_sheet3(i, 0) = Sheet2.Range("A" & i + 2)
array_sheet3(i, 1) = Sheet2.Range("B" & i + 2)
array_sheet3(i, 2) = Sheet2.Range("C" & i + 2)
Next i
'replace the Label ID with the Label Name
For i = 0 To LastRow2 - 2
For j = 0 To LastRow1 - 2
If array_sheet3(i, 0) = array_sheet1(j, 0) Then
array_sheet3(i, 0) = array_sheet1(j, 1)
Else
End If
Next j
Next i
'write the values to sheet3
For i = 0 To LastRow2 - 2
Sheet3.Range("A" & i + 2) = array_sheet3(i, 0)
Sheet3.Range("B" & i + 2) = array_sheet3(i, 1)
Sheet3.Range("C" & i + 2) = array_sheet3(i, 2)
Next i


'rest of code is to help user if there is missing data
'- creates an array of missing items _
the array is put in column D on sheet1 _
also builds up a text string which lists the missing data _
final message box reports that to the user


'check for missing label name in the index (sheet1)
k = 0 'counter for missing data
For i = 0 To LastRow1 - 2
If array_sheet1(i, 1) = "" Then
array_errors(k, 0) = "Missing label name for " & array_sheet1(i, 0)
str_array_errors = str_array_errors & txt & array_errors(k, 0) & vbCrLf
k = k + 1
Else
End If
Next i
'check for missing label ID in the index sheet1)
For i = 0 To LastRow2 - 2
For j = 0 To LastRow1 - 2
If Sheet2.Range("A" & i + 2).Value = array_sheet1(j, 0) Then
j = LastRow1 - 2
Else
If j = LastRow1 - 2 Then
array_errors(k, 0) = "Index does not contain Label ID " & Sheet2.Range("A" & i + 2).Value
str_array_errors = str_array_errors & txt & array_errors(k, 0) & vbCrLf
k = k + 1
Else
End If
End If
Next j
Next i
'write list of missing label names and label IDs to sheet1
For i = 0 To k - 1
Sheet1.Range("D" & i + 1) = array_errors(i, 0)
Next i
'message box lists the missing items
MsgBox str_array_errors
End Sub

[cal911]

Thank you so much Paul and Yongle! It's the same person - just updated my username... Your code is great Yongle. If I wanted to sort the consolidated worksheet, I would just add the following to the end correct?



Sheet3.Range("A2").Sort Key1:=Sheet3.Range("A2"), _
Order1:=xlAscending, Header:=xlYes

[Yongle]

Your code is not totally correct - not terribly useful to only sort one cell (A2) - the one good thing is it will not mess up the data!
You need to tell give the whole range to be sorted (column range and row range). So again we need to work out where the bottom of the data is. We want to sort columns A to C, to the last row.

I always try to declare all my variables, etc . I also like to set variables for the various ranges. It is a bit over the top here, but it is a lot clearer and more flexible as code becomes more complex.




Sub SortA()
'declare variables
Dim LastRow3 As Long
Dim SortRange As Range, SortKey As Range
'determine last row of sort area
LastRow3 = Worksheets("Sheet3").Range("A1").End(xlDown).Row
'set the sort area, and sort key
Set SortRange = Sheet3.Range("A1:C" & LastRow3)
Set SortKey = Sheet3.Range("A1")
'sort the data
SortRange.Sort Key1:=SortKey, Order1:=xlAscending, Header:=xlYes
End Sub


But in this case you could use:



Sub SortB()
LastRow3 = Worksheets("Sheet3").Range("A1").End(xlDown).Row
Sheet3.Range("A1:C" & LastRow3).Sort Key1:=Sheet3.Range("A1"), Order1:=xlAscending, Header:=xlYes
End Sub