Compare 2 cells in 2 sheets, if both match append data in Sheet2 to Sheet1

[furious0331]

I am having such a difficult time creating a macro that will help me reduce the 5+hours I have to spend each week manually copying & pasting all of this data. If anyone can help, please know that you will be making an IMMENSE difference in this worker bee's life!!

I have a workbook with two sheets (Sheet1 & Sheet2). Sheet1 has license #'s in column A and the state that the license belongs to in column B like this:


COLUMN A COLUMN B
11111 Alaska
11112 Alabama
11113 Arkansas
11114 Arkansas

Sheet2 has three columns (A, B, C). Column A has the license #'s, column B has the state that the license belongs to and Columns C shows a line-of-authority tied to that license #.


COLUMN A COLUMN B COLUMN C
11111 Alaska Property
11111 Alaska Casualty
11112 Alaska Life
11112 Alaska Health
11112 Alabama Property
11112 Alabama Casualty
11113 Arkansas Life
11113 Arkansas Health
11114 Arkansas Life
11114 Arkansas Health
12345 Arizona Property


I'm trying to write a macro that will compare the license # and state in Sheet1 to the license # and state in Sheet2. If it matches, append the contents of Column C to the corresponding row in Sheet1.

Here's the thing...Sheet2 contains the entries for all licenses in the company (so this table is HUGE). And there are multiple entries for each state license # (notice how there's two entries above for AK license # 11111 - one for the Property line and one for the Casualty line.

After my macro is run, I want Sheet1 to show all the lines-of-authority on a single line. So if I ran my macro on the above example, after it's run I would have this in Sheet1:

COLUMN A COLUMN B COLUMN C
11111 Alaska Property Casualty
11112 Alabama Property Casualty
11113 Arkansas Life Health
11114 Arkansas Life Health

PLEASE HELP!!!

[Sa DQ]

COLUMN A COLUMN B COLUMN C
11111 Alaska Property Casualty
11112 Alabama Life Health Property Casualty
11113 Arkansas Life Health
11114 Arkansas Life Health

Option Explicit 
Sub HopeThisHelp() 
 Dim Rng As Range, sRng As Range, Cls As Range, Sh As Worksheet 
 Dim MyAdd As String, Rws As Long 
  
 Set Sh = Sheet2:               Rws = Sh.Rows.Count 
 Sheet1.Select 
 Set Rng = Sh.Range(Sh.[A1], Sh.Cells(Rws, "A").End(xlUp)) 
 For Each Cls In Range([A2], [A2].End(xlDown)) 
    'Cls.Offset(, 2).Clear 
     
    Set sRng = Rng.Find(Cls.Value, , xlValues, xlWhole) 
    If Not sRng Is Nothing Then 
        MyAdd = sRng.Address 
        Do 
            With Cls.Offset(, 2) 
                .Value = .Value & " " & sRng.Offset(, 2).Value 
            End With 
             
            Set sRng = Rng.FindNext(sRng) 
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd 
    Else 
        MsgBox "Nothing", , Cls.Value 
    End If 
 Next Cls 
End Sub  

[furious0331]

Sa DQ - Thank you SOOOOO MUCH for taking the time to read and help me with my issue. I can't tell you how much I appreciate your help and your quick response.

This is definitely a great start for me to continue and hopefully I can modify this to work the way I want it to. I noticed that you highlighted "Life Health" in red for Alabama license #11112. Yes, these two entries should not be there (Rows 4 & 5 of Sheet2 should be ignored by the macro since Alaska #11112 is not found on Sheet1). Something tells me that your macro only compared the license # and not the state?

Again - Thank you!

[Sa DQ]

Option Explicit
Sub HopeThisHelp()
 Dim Rng As Range, sRng As Range, Cls As Range, Sh As Worksheet
 Dim MyAdd As String, Rws As Long
 
 Set Sh = Sheet2:               Rws = Sh.Rows.Count
 Sheet1.Select
 Set Rng = Sh.Range(Sh.[A1], Sh.Cells(Rws, "A").End(xlUp))
 For Each Cls In Range([A2], [A2].End(xlDown))
    Cls.Offset(, 2).Clear
    
    Set sRng = Rng.Find(Cls.Value, , xlValues, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            With Cls.Offset(, 2)
                If sRng.Offset(,1).value= Cls.Offset(,1).value Then _
                            .Value = .Value & " " & sRng.Offset(, 2).Value

            End With
            
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    Else
        MsgBox "Nothing", , Cls.Value
    End If
 Next Cls
End Sub  

[Sa DQ]

!!!!!! Delete this post!

[furious0331]

Wow! You have some serious skills, Sa DQ!

THANK YOU!!!