SOLVED

Excel help with copying rows from 2 sheets to new sheet

Brass Contributor

I have a workbook with Sheet1 and Sheet2.  Sheet1 columns are 'SSN' and '2019 Hours'.  Sheet2 columns are 'SSN' and '2020 Hours'.

I need to match Sheet1 column 'SSN' to Sheet2 column 'SSN' and create Sheet3 with 'SSN', '2019 Hours' and '2020 Hours'.

 

It's possible that Sheet1 column 'SSN' won't have a match in Sheet2, in that case I would just copy Sheet1 column 'SSN' and '2019 Hours' , or it's possible Sheet2 may have a 'SSN' that Sheet1 doesn't, in that case I would just copy Sheet2 column 'SSN' and '2020 Hours'.

 

I've uploaded some test data for reference.

 

Would this require a VB macro to accomplish?  If so, does anyone have something similar they are willing to share?

 

thanks in advance!!

Rufus 

6 Replies
best response confirmed by Rufus_Bertrand (Brass Contributor)
Solution

@Rufus_Bertrand 

Here is a macro:

Sub CombineSheets()
    ' Change the constants to the actual names of your sheets
    Const sh1 = "Sheet1"
    Const sh2 = "Sheet2"
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim col As New Collection
    Dim r As Long
    Dim m1 As Long
    Dim m2 As Long
    Dim v As Variant
    Application.ScreenUpdating = False
    Set ws1 = Worksheets(sh1)
    m1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
    On Error Resume Next
    For r = 2 To m1
        col.Add Key:=CStr(ws1.Range("A" & r).Value), Item:=ws1.Range("A" & r).Value
    Next r
    On Error GoTo 0
    Set ws2 = Worksheets(sh2)
    m2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row
    On Error Resume Next
    For r = 2 To m2
        col.Add Key:=CStr(ws2.Range("A" & r).Value), Item:=ws2.Range("A" & r).Value
    Next r
    On Error GoTo 0
    Set ws3 = Worksheets("Sheet3")
    ws3.Range("A1:C1").Value = Array("SSN", "2019 HRS", "2020 HRS")
    r = 2
    For Each v In col
        ws3.Range("A" & r).Value = v
        r = r + 1
    Next v
    ws3.Range("B2:B" & col.Count + 1).Formula = "=IFERROR(VLOOKUP(A2,'" & sh1 & "'!$A$2:B$" & m1 & ",2,FALSE),"""")"
    ws3.Range("C2:C" & col.Count + 1).Formula = "=IFERROR(VLOOKUP(A2,'" & sh2 & "'!$A$2:B$" & m2 & ",2,FALSE),"""")"
    Application.ScreenUpdating = True
End Sub

See the attached version, now a macro-enabled workbook. Make sure that you allow macros when you open it.

Hans to the rescue again!

That's going to work great. I'm going to go through the macro and make sure I understand what it is you're having it do. I may reach out to you with a couple of questions next week, if that's ok?


thanks again!
Rufus

@Rufus_Bertrand 

@Rufus_Bertrand Just wanted to show a solution that doesn't require VBA and which really is very simple and ultimately flexible. Spend some time learning Power Query and you will probably not need much VBA in the future. With Power Query you connect to the two tables (or named ranges) that contain the hours for each year. Then append the two and group by SSN. All done with standard User Interface buttons. No programming required. Writing this post took longer than creating the table in Sheet3 (attached).

HI Riny_van_Eekelen,
I've never used Power Query, but it does sound very promising!

Do you know of a good resource to lean more about it?


thanks,
Rufus

@Rufus_Bertrand 

You may start with https://powerquery.microsoft.com/en-us/ and  in Excel File->New,  search Power Query, it will be template with basics.

After that a lot of resources.

1 best response

Accepted Solutions
best response confirmed by Rufus_Bertrand (Brass Contributor)
Solution

@Rufus_Bertrand 

Here is a macro:

Sub CombineSheets()
    ' Change the constants to the actual names of your sheets
    Const sh1 = "Sheet1"
    Const sh2 = "Sheet2"
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim col As New Collection
    Dim r As Long
    Dim m1 As Long
    Dim m2 As Long
    Dim v As Variant
    Application.ScreenUpdating = False
    Set ws1 = Worksheets(sh1)
    m1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
    On Error Resume Next
    For r = 2 To m1
        col.Add Key:=CStr(ws1.Range("A" & r).Value), Item:=ws1.Range("A" & r).Value
    Next r
    On Error GoTo 0
    Set ws2 = Worksheets(sh2)
    m2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row
    On Error Resume Next
    For r = 2 To m2
        col.Add Key:=CStr(ws2.Range("A" & r).Value), Item:=ws2.Range("A" & r).Value
    Next r
    On Error GoTo 0
    Set ws3 = Worksheets("Sheet3")
    ws3.Range("A1:C1").Value = Array("SSN", "2019 HRS", "2020 HRS")
    r = 2
    For Each v In col
        ws3.Range("A" & r).Value = v
        r = r + 1
    Next v
    ws3.Range("B2:B" & col.Count + 1).Formula = "=IFERROR(VLOOKUP(A2,'" & sh1 & "'!$A$2:B$" & m1 & ",2,FALSE),"""")"
    ws3.Range("C2:C" & col.Count + 1).Formula = "=IFERROR(VLOOKUP(A2,'" & sh2 & "'!$A$2:B$" & m2 & ",2,FALSE),"""")"
    Application.ScreenUpdating = True
End Sub

See the attached version, now a macro-enabled workbook. Make sure that you allow macros when you open it.

View solution in original post