Updating master sheet from multiple sheets

0
votes

Hi there I am trying to create a macro that would extract data from source sheet into a master sheet, it would check whether there is any existing record in the master sheet, if there is it will update the record in the master sheet with the latest data from source sheet, if there isn't it will add the data from source sheet into the master sheet. I managed to piece together below code which is able to do just that for one customer (single sheet), could anyone advise how to modify it to allow updating of multiple sheets. Understand I need looping of worksheets to do that but I am hitting errors thus far. Any help is much appreciated!

Sub Update()
Dim wsSrc As Worksheet, wsDest As Worksheet, i As Integer, j As Integer, k As Integer, srcLastRow As Long, destLastRow As Long, srcFndVal As String, destFndCell As Range, srcValRow As Long, destValRow As Long, destFndVal As String, srcFndCell As Range
Application.ScreenUpdating = False
Set wsSrc = Worksheets("Cust A")
Set wsDest = Worksheets("Master")
srcLastRow = wsSrc.Cells(Rows.Count, "BA").End(xlUp).Row
destLastRow = wsDest.Cells(Rows.Count, "A").End(xlUp).Row
j = wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    With wsDest
        For i = 4 To srcLastRow
        srcFndVal = wsSrc.Cells(i, "AA")
        Set destFndCell = .Range("A:A").Find(srcFndVal, LookIn:=xlValues)
            If destFndCell Is Nothing And wsSrc.Cells(i, "AA").Value <> "" Then
                .Range("A" & j & ":F" & j).Value = wsSrc.Range("AA" & i & ":AF" & i).Value
                .Range("J" & j & ":K" & j).Value = wsSrc.Range("AG" & i & ":AH" & i).Value
                .Range("G" & j & ":H" & j).Value = wsSrc.Range("AE" & i & ":AF" & i).Value
                j = j + 1
            Else
        srcValRow = wsSrc.Range("AA:AA").Find(what:=srcFndVal, after:=wsSrc.Range("AA4"), LookIn:=xlValues).Row
        destValRow = wsDest.Range("A:A").Find(what:=srcFndVal, after:=wsDest.Range("A4"), LookIn:=xlValues).Row
                .Range("B" & destValRow & ":F" & destValRow).Value = wsSrc.Range("AB" & srcValRow & ":AF" & srcValRow).Value
                .Range("J" & destValRow & ":K" & destValRow).Value = wsSrc.Range("AG" & srcValRow & ":AH" & srcValRow).Value
            End If
        Next
        For k = 4 To destLastRow
        destFndVal = wsDest.Cells(k, "A")
        Set srcFndCell = wsSrc.Range("AA:AA").Find(destFndVal, LookIn:=xlValues)
            If srcFndCell Is Nothing And wsDest.Cells(k, "A").Value <> "" Then
                .Range("B" & k & ":F" & k).Value = vbNullString
            End If
        Next
    End With
Application.ScreenUpdating = True
End Sub

I modified the code to loop through the worksheets in an array however there is an issue with getting the last row of the wsSrc, Run-time error 424 Object required. Below line is highlighted, could anyone advise how to solve this? Sorry I am new to VBA, any help is greatly appreciated.

srcLastRow = wsSrc.Cells(Rows.Count, "AA").End(xlUp).Row

Sub Update()
Dim wsSrc As Variant, srcList As Variant, wsDest As Worksheet, i As Integer, j As Integer, k As Integer, srcLastRow As Long, destLastRow As Long, srcFndVal As String, destFndCell As Range, srcValRow As Long, destValRow As Long, destFndVal As String, srcFndCell As Range
Application.ScreenUpdating = False
srcList = Array("Cust A", "Cust B", "Cust C", "Cust D", "Cust E", "Cust F", "Cust G")
Set wsDest = Worksheets("Master")
srcLastRow = wsSrc.Cells(Rows.Count, "AA").End(xlUp).Row
destLastRow = wsDest.Cells(Rows.Count, "A").End(xlUp).Row
j = wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
For Each wsSrc In srcList
    With wsDest
        For i = 4 To srcLastRow
        srcFndVal = wsSrc.Cells(i, "AA")
        Set destFndCell = .Range("A:A").Find(srcFndVal, LookIn:=xlValues)
            If destFndCell Is Nothing And wsSrc.Cells(i, "AA").Value <> "" Then
                .Range("A" & j & ":F" & j).Value = wsSrc.Range("AA" & i & ":AF" & i).Value
                .Range("J" & j & ":K" & j).Value = wsSrc.Range("AG" & i & ":AH" & i).Value
                .Range("G" & j & ":H" & j).Value = wsSrc.Range("AE" & i & ":AF" & i).Value
                j = j + 1
            Else
        srcValRow = wsSrc.Range("AA:AA").Find(what:=srcFndVal, after:=wsSrc.Range("AA4"), LookIn:=xlValues).Row
        destValRow = wsDest.Range("A:A").Find(what:=srcFndVal, after:=wsDest.Range("A4"), LookIn:=xlValues).Row
                .Range("B" & destValRow & ":F" & destValRow).Value = wsSrc.Range("AB" & srcValRow & ":AF" & srcValRow).Value
                .Range("J" & destValRow & ":K" & destValRow).Value = wsSrc.Range("AG" & srcValRow & ":AH" & srcValRow).Value
            End If
        Next
        For k = 4 To destLastRow
        destFndVal = wsDest.Cells(k, "A")
        Set srcFndCell = wsSrc.Range("AA:AA").Find(destFndVal, LookIn:=xlValues)
            If srcFndCell Is Nothing And wsDest.Cells(k, "A").Value <> "" Then
                .Range("B" & k & ":F" & k).Value = vbNullString
            End If
        Next
    End With
Next wsSrc
Application.ScreenUpdating = True
End Sub
2
excelvbaupdatingdata-extraction

2 Answers

1
votes

Try this

Sub Update()
    Dim wsSrc  As Worksheet
    For Each wsSrc In ThisWorkbook.Worksheets
        If wsSrc.Name <> "Master" Then
            'Do bla bla...
        End If
    Next
End Sub
1
votes

I have fix your code. Try this. Your matter is wsSrc is a WorkSheet Object, but srcList is an array of String. They are not match each other. I use a condition that wsSrc name start with "Cust" instead. Tell me if this solved your problem

Sub Update()
    Dim wsSrc, wsDest As Worksheet
    Dim i, j, k As Integer
    Dim srcLastRow, destLastRow, srcValRow, destValRow As Long
    Dim srcFndVal, destFndVal As String
    Dim destFndCell, srcFndCell As Range
    
    Application.ScreenUpdating = False
    Set wsDest = Worksheets("Master")
    For Each wsSrc In ThisWorkbook.Worksheets
        If Left(wsSrc.Name, 4) = "Cust" Then
            srcLastRow = wsSrc.Cells(Rows.Count, "BA").End(xlUp).Row
            destLastRow = wsDest.Cells(Rows.Count, "A").End(xlUp).Row
            j = wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
            With wsDest
                For i = 4 To srcLastRow
                    srcFndVal = wsSrc.Cells(i, "AA")
                    Set destFndCell = .Range("A:A").Find(srcFndVal, LookIn:=xlValues)
                    If destFndCell Is Nothing And wsSrc.Cells(i, "AA").Value <> "" Then
                        .Range("A" & j & ":F" & j).Value = wsSrc.Range("AA" & i & ":AF" & i).Value
                        .Range("J" & j & ":K" & j).Value = wsSrc.Range("AG" & i & ":AH" & i).Value
                        .Range("G" & j & ":H" & j).Value = wsSrc.Range("AE" & i & ":AF" & i).Value
                        j = j + 1
                    Else
                        srcValRow = wsSrc.Range("AA:AA").Find(what:=srcFndVal, after:=wsSrc.Range("AA4"), LookIn:=xlValues).Row
                        destValRow = wsDest.Range("A:A").Find(what:=srcFndVal, after:=wsDest.Range("A4"), LookIn:=xlValues).Row
                        .Range("B" & destValRow & ":F" & destValRow).Value = wsSrc.Range("AB" & srcValRow & ":AF" & srcValRow).Value
                        .Range("J" & destValRow & ":K" & destValRow).Value = wsSrc.Range("AG" & srcValRow & ":AH" & srcValRow).Value
                    End If
                Next
                For k = 4 To destLastRow
                    destFndVal = wsDest.Cells(k, "A")
                    Set srcFndCell = wsSrc.Range("AA:AA").Find(destFndVal, LookIn:=xlValues)
                    If srcFndCell Is Nothing And wsDest.Cells(k, "A").Value <> "" Then .Range("B" & k & ":F" & k).Value = vbNullString
                Next
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub