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

2
votes

I need some help writing some VBA for Excel. I have a single spreadsheet 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
1   Company Name        Contact 
2   Apple Inc           Bruce Kemp
3   Grape Pty           Steve Sampson
4   Pear Pty        
5   Peach Pty       
6   Watermelon Pty      Bob Brown
7   Honey Pty           Luis White

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

If a match is found, the value contained in the Contact Column of Sheet2 (Column B) 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.

2
excelvba
I'm pretty sure you could do this with standard Excel functions. Check out the LOOKUP function: techonthenet.com/excel/formulas/lookup.php – Eraph
Vlookup will show me the results of a match but I am after some actual VB code with some logic behind it. I need to be able to insert a new row if no match is found. Vlookup wont do this. – Andy Bozzly

2 Answers

1
votes

Wasn't sure how comfortable you are with VBA so I commented the code pretty thoroughly. Hope this helps!

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
0
votes
Sub compare()
    For i = 1 To last_cell_mainSheet
        For j = 1 To last_cell_sheet2
        If Worksheets("main_sheet").Range("a" & i).Value = Worksheets("sheet2").Range("a" & j).Value Then
           Worksheets("main_sheet").Range("C" & i).Value = Worksheets("sheet2").Range("b" & j).Value
        End If
        Next j
    Next i
End Sub