PDA

View Full Version : [SOLVED] Compare 2 columns from separate sheets and create new sheet with data from both



pijo17
01-21-2020, 11:48 AM
I've attached a sample file to this post which shows what I'm trying to accomplish. Data is stored in Sheet1 and Sheet2, and I want the output shown in Sheet3 - problem explained below.

In Sheet1, there are 9 columns of data (A through I).

In Sheet2, there are 26 columns of data (A through Z).

In both sheets, the first row is a header row, so the actual data starts in row 2.

I want to compare Column I (the 9th column) from Sheet1 to Column B (the 2nd column) of Sheet2. If there is a match, create a row for this match in a new sheet (Sheet3) which includes particular data fields from Sheet1 and Sheet2 (explained below*).

These columns are different in size in my actual file, and the data is not ordered the same way (also, the column in Sheet2 is much, much longer than the column from Sheet1, by about 30,000 rows). So I DON'T want to just check I2 from Sheet1 against B2 from Sheet2, I3 against B3, and so on.



All data in Column I in Sheet1 should compared against all data in Column B in Sheet2.

*If there is a match (cells contain the same value), the corresponding row in Sheet3 should contain data from the following columns (in order, starting with Column A):

1) Column 2 from Sheet1
2) Column 9 from Sheet1
3) Column 4 from Sheet2
4) Column 7 from Sheet2
5) Column 11 from Sheet2
6) Column 12 from Sheet2

For example, if the value in I2 from Sheet1 matches ANY of the values from B2:B in Sheet2, then there would be a row placed in Sheet3 with 6 columns of data corresponding to the list above. Each value is unique, so there will never be a case when there is more than one match and therefore this situation doesn't need to be considered.

I've tried to write the following macro as a solution:



Sub CreateReport()
Application.ScreenUpdating = False
Dim srcWS1 As Worksheet, srcWS2 As Worksheet, desWS As Worksheet, i As Long, v1 As Variant, v2 As Variant, LastRow As Long
Set srcWS1 = Sheet1
Set srcWS2 = Sheet2
Set desWS = Sheet3
v1 = srcWS1.Range("A2", srcWS1.Range("A" & Rows.Count).End(xlUp)).Resize(, 9).Value
v2 = srcWS2.Range("A2", srcWS2.Range("A" & Rows.Count).End(xlUp)).Resize(, 26).Value
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(v2, 1)
If Not .Exists(v2(i, 2)) Then
.Add v2(i, 2), Nothing
End If
Next i
For i = 1 To UBound(v1, 1)
If v1(i, 9) = v2(i, 2) Then
LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
With desWS
.Range("A" & LastRow).Resize(, 6) = Array(v1(i, 2), v1(i, 9), v2(i, 4), v2(i, 7), v2(i, 11), v2(i, 12))
End With
End If
Next i
End With
Application.ScreenUpdating = True
End Sub

However, when running this macro, it effectively does nothing. How can I fix this? Essentially I'm trying to write a loop that cycles through and checks all possible "pairs" of data between the two aforementioned columns and creates an array with the data from the match.

Thank you in advance for the help!

Leith Ross
01-21-2020, 02:49 PM
Hello pij017,

Welcome the forum!

Column "A" on "Sheet2" is empty and you sized the range based on the last row in column "A". I changed the code to start at "A2" but used column "B" to find the last row. The output looks correct to me. Run the amended macro and let me know if it is correct.



Sub CreateReport()


Dim srcWS1 As Worksheet, srcWS2 As Worksheet, desWS As Worksheet, i As Long, v1 As Variant, v2 As Variant, LastRow As Long

Application.ScreenUpdating = False

Set srcWS1 = ThisWorkbook.Worksheets("Sheet1")
Set srcWS2 = ThisWorkbook.Worksheets("Sheet2")
Set desWS = ThisWorkbook.Worksheets("Sheet3")

v1 = srcWS1.Range("A2", srcWS1.Range("A" & Rows.Count).End(xlUp)).Resize(, 9).Value

' Change made to line below.
v2 = srcWS2.Range("A2", srcWS2.Cells(Rows.Count, "B").End(xlUp)).Resize(, 26).Value


With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(v2, 1)
If Not .Exists(v2(i, 2)) Then
.Add v2(i, 2), Nothing
End If
Next i

For i = 1 To UBound(v1, 1)
If v1(i, 9) = v2(i, 2) Then
LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
With desWS
.Range("A" & LastRow).Resize(, 6) = Array(v1(i, 2), v1(i, 9), v2(i, 4), v2(i, 7), v2(i, 11), v2(i, 12))
End With
End If
Next i
End With

Application.ScreenUpdating = True

End Sub