Results 1 to 4 of 4

Thread: Macro to combine two sheets based on common ID number for 7 sheets
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Apr 2017
    Posts
    2
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Macro to combine two sheets based on common ID number for 7 sheets

    Hi all,

    I found this excellent macro from a past post, lamentably this work fine for 2 sheets but lamentably
    I could not modify to work with 7 sheets...

    Please any advice I will gratefull
    Regards

    The macro is:

    Sub TestGridUpdate()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim TestGridFound As Boolean
    Dim r As Range

    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")

    ' Look for TestGrid worksheet
    TestGridFound = False
    For Each ws In Worksheets
    If ws.Name = "TestGrid" Then TestGridFound = True
    Next

    'If TestGrid is found then use it else create it
    If TestGridFound Then
    Set ws3 = ThisWorkbook.Worksheets("TestGrid")
    ws3.Cells.Clear
    Else
    Set ws3 = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
    ws3.Name = "TestGrid"
    End If

    ' Copy ws1 to ws3 (TestGrid)
    ws3.Range(ws1.UsedRange.Address).Value = ws1.UsedRange.Value

    ' Add ws2 details to ws3 (TestGrid)
    For Each r In ws3.UsedRange.Rows
    ID = r.Cells(, 1).Value
    iRow = Application.Match(ID, ws2.UsedRange.Columns(1), 0)
    ws2.Range("B" & iRow & ":U" & iRow).Copy ws3.Range("Q" & r.Row)
    Next

    End Sub

  2. #2
    Board Regular
    Join Date
    Sep 2013
    Location
    Blue Mountains, Australia
    Posts
    3,468
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro to combine two sheets based on common ID number for 7 sheets

    Welcome to the Forum!

    Your macro:

    - copies the contents of "Sheet1" to "TestGrid"
    - For each row in "TestGrid", finds the matching ID in Sheet2 and copies columns B:U from "Sheet2" into columns Q:AJ of "TestGrid".

    What do you want to have happen with the other five worksheets?

  3. #3
    Board Regular
    Join Date
    May 2005
    Location
    Indiana
    Posts
    138
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro to combine two sheets based on common ID number for 7 sheets

    Possibly...
    Code:
    Sub TestGridUpdate()
        Dim WS As Worksheet
        Dim TG As Worksheet
        Dim r As Range
        Dim ID As Variant
        Dim iRow As Long
        
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        
        For Each WS In Worksheets
            If WS.Name = "TestGrid" Then WS.Delete
        Next
        Worksheets("Sheet1").Copy After:=Worksheets(Worksheets.Count)
        Set TG = Worksheets(Worksheets.Count)
        TG.Name = "TestGrid"
        
        For Each WS In Worksheets
            If WS.Name <> "TestGrid" And WS.Name <> "Sheet1" Then
                For Each r In TG.UsedRange.Rows
                    ID = r.Cells(, 1).Value
                    iRow = Application.Match(ID, WS.UsedRange.Columns(1), 0)
                    WS.Range("B" & iRow & ":U" & iRow).Copy TG.Range("Q" & r.Row)
                Next
            End If
        Next
        
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
    End Sub

  4. #4
    New Member
    Join Date
    Apr 2017
    Posts
    2
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Macro to combine two sheets based on common ID number for 7 sheets

    Hi all!

    Thanks for your fast replay, lamentably I could not get good results with your advice (probably because my native language is spanish, so i could explain correctly) in my consolidate last table.

    For this reason I modify succesfully the past macro, here I attach the last macro for 4 sheets (for spanish language:Hoja1...).

    Regards anh thanks again

    Sub TestGridUpdate()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim ws4 As Worksheet
    Dim ws5 As Worksheet

    Dim TestGridFound As Boolean
    Dim r As Range

    Set ws1 = ThisWorkbook.Worksheets("Hoja1")
    Set ws2 = ThisWorkbook.Worksheets("Hoja2")
    Set ws3 = ThisWorkbook.Worksheets("Hoja3")
    Set ws4 = ThisWorkbook.Worksheets("Hoja4")

    ' Look for TestGrid worksheet
    TestGridFound = False
    For Each WS In Worksheets
    If WS.Name = "TestGrid" Then TestGridFound = True
    Next

    'If TestGrid is found then use it else create it
    If TestGridFound Then
    Set ws5 = ThisWorkbook.Worksheets("TestGrid")
    ws5.Cells.Clear
    Else
    Set ws5 = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
    ws5.Name = "TestGrid"
    End If

    ' Copy ws1 to ws3 (TestGrid)
    ws5.Range(ws1.UsedRange.Address).Value = ws1.UsedRange.Value


    ' Add ws2 details to ws3 (TestGrid)
    For Each r In ws5.UsedRange.Rows
    ID = r.Cells(, 1).Value
    iRow = Application.Match(ID, ws2.UsedRange.Columns(1), 0)
    ws2.Range("B" & iRow & ":U" & iRow).Copy ws5.Range("C" & r.Row)

    iRow = Application.Match(ID, ws3.UsedRange.Columns(1), 0)
    ws3.Range("B" & iRow & ":U" & iRow).Copy ws5.Range("F" & r.Row)

    iRow = Application.Match(ID, ws4.UsedRange.Columns(1), 0)
    ws4.Range("B" & iRow & ":U" & iRow).Copy ws5.Range("H" & r.Row)

    Next

    End Sub

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •