Code needed to loop through column range, check if multiple values exists and then copy cells

2
votes

I need some help writing some VBA for Excel. I posted this under a different quesiton, but found a related one that if slightly modified could help. I have a single workbook with two worksheets. One worksheet is called Master, the other is called Sheet2. Here is what the Master worksheet looks like:

            A               B                  C
1   Company Name        Company Interests   Contact 
2   Apple Inc           Waterskiing         
3   Grape Pty           Bush walking        
4   Pear Pty        
5   Peach Pty           Movies
6   Watermelon Pty      Reading Books       Bob Brown

Here is what Sheet2 looks like:

          A                B                C 
1   Company Name        Company Interests   Contact 
2   Apple Inc           Waterskiing         Bruce Kemp
3   Grape Pty           Bush walking        Steve Sampson
4   Pear Pty        
5   Peach Pty           Movies
6   Watermelon Pty      Reading Books       Bob Brown
7   Honey Pty           Sports              Luis White

What I want to do is loop through all the Company Names (Column A) AND Company Interests in worksheet Sheet2 and check against the Company Names (column A) AND Company Interests in the Master worksheet.

If a match is found for both criteria, the value contained in the Contact Column of Sheet2 (Column C) is copied to the Contact Column (column C) in Master for the correct row.

If no match is found then the entire row in Sheet2 is copied to the first empty row in the Master Sheet.

The person who had previously posted this question only need company name match and a user provided the below code for that. I believe only one additional For Loop needs to be added to ensure both elements match, but I am unsure how to do that. Any help is appreciated.

Sub Compare()

Dim WS As Worksheet
Set WS = Sheets("Master")

Dim RowsMaster As Integer, Rows2 As Integer
RowsMaster = WS.Cells(1048576, 1).End(xlUp).Row
Rows2 = Worksheets(2).Cells(1048576, 1).End(xlUp).Row
' Get the number of used rows for each sheet

With Worksheets(2)
    For i = 2 To Rows2
    ' Loop through Sheet 2
        For j = 2 To RowsMaster
        ' Loop through the Master sheet
            If .Cells(i, 1) = WS.Cells(j, 1) Then
            ' If a match is found:
                WS.Cells(j, 3) = .Cells(i, 2)
                ' Copy in contact info
                Exit For
                ' No point in continuing the search for that company
            ElseIf j = RowsMaster Then
            ' If we got to the end of the Master sheet 
            ' and haven't found a company match
                RowsMaster = RowsMaster + 1
                ' Increment the number of rows
                For k = 1 To 3 ' Change 3 to however many fields Sheet2 has
                    WS.Cells(RowsMaster, k) = .Cells(i, k)
                    ' Copy the data from Sheet2 in on the bottom row of Master
                Next
            End If
        Next j
    Next i
End With

End Sub

2
vbaexcelfor-loop
@huguespaquetblanchette If you're going to edit this, at least change text to code? - findwindow

2 Answers

1
votes
If .Cells(i, 1) = WS.Cells(j, 1) Then

should be changed to 

If .Cells(i, 1) = WS.Cells(j, 1) And .Cells(i, 2) = WS.Cells(j, 2) Then

to signify that we are checking both columns A & B in order to find a match.

Then WS.Cells(j, 3) = .Cells(i, 2) should be changed to WS.Cells(j, 3) = .Cells(i, 3) to fill in the last piece of data from column C.

0
votes

Try this:

Option Explicit
Sub match()

Dim wb As Workbook
Dim wsM As Worksheet, ws2 As Worksheet
Dim i As Integer, j As Integer
Dim lastrow As Long, lastrow2 As Long

Set wsM = Sheets("Master")
Set ws2 = Sheets("Sheet2")

lastrow = wsM.Range("A" & Rows.Count).End(xlUp).Row
lastrow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lastrow2

        For j = 2 To lastrow

            ' Check your 2 condition Column A and B of both sheets
            If wsM.Range("A" & j) = ws2.Range("A" & i) And wsM.Range("B" & j) = ws2.Range("B" & i) Then

                        wsM.Range("C" & j) = ws2.Range("C" & i).Value

            End If

        Next j

' If no match then past in the master sheet
               ws2.Range("A" & i & ":" & "C" & i).Copy wsM.Range("A" & lastrow + 1)

                lastrow = wsM.Range("A" & Rows.Count).End(xlUp).Row
Next i

End Sub