VBA code to extract unique data across multiple sheets and multiple columns

[mereslav]

Hi everyone,

I'm searching the web but I only found one code that kind of works but I need to make it more complex.
Let me explain.
My issue is that I have an Excel sheet with multiple worksheets, which all contain the same kind of information but are copied weekly by me. So every week, I will add one more worksheet.
Each worksheet contains a list of workers we have with their ID number, clock in and clock out and also start date, area of work etc.. basically the data spans from column A to column G and starts in row 7 and goes to infinity as every week there's a different number of workers as some are hired, and some resign.
In Sheet1, I want to have a button named Update Worker List (already have that :D) that will run this VBA code when I click it, and put a new updated list of all the workers we have in the latest worksheet ( I understand it will include even those that have resigned, but that is okay) in columns A to G, starting in row 3.

I have this at the moment but it only extracts column A.

Don't get confused, WC240122 means Week Commencing 24/01/22...

'' 'Example of how to use scripting dictionary to list unique values
''' Assumes data is in column A of "Sheet1", "Sheet2", "Sheet3", "Sheet4", & "Sheet5"
''' Results are written to "Sheet6"
'
Sub GetUnique()
Dim Rng As Range, R As Range
Dim SD As Object
Dim KeyStr As String, RefStr As String
Dim WB As Workbook
Dim WS As Worksheet
Dim I As Long

Set WB = ActiveWorkbook
Set WS = ActiveSheet

Set SD = CreateObject("Scripting.dictionary")
RefStr = "" 'Value stored in dictionary

For Each WS In WB.Worksheets
Select Case WS.Name
Case "WC170122", "WC240122", "WC310122", "WC070222", "WC140222"
Set Rng = WS.Range("A7:A" & WS.Range("A" & WS.Rows.Count).End(xlUp).Row)
For Each R In Rng
KeyStr = R.Value 'Search Key stored in dictionary
If Not SD.Exists(KeyStr) Then 'Unique key value, not already in the dictionary
SD.Add KeyStr, RefStr
End If
Next R
End Select
Next WS

Set WS = WB.Worksheets("Sheet1")
WS.Range("A3:G300").ClearContents

With WS.Range("A3")
For I = 0 To SD.Count - 1
.Offset(I).Value = SD.keys()(I)
Next I
End With
End Sub

Thank you very much for helping.

 

[mereslav]

Sorry for the format, here it is correctly

'' 'Example of how to use scripting dictionary to list unique values
''' Assumes data is in column A of "Sheet1", "Sheet2", "Sheet3", "Sheet4", & "Sheet5"
''' Results are written to "Sheet6"
'
Sub GetUnique()
    Dim Rng As Range, R As Range
    Dim SD As Object
    Dim KeyStr As String, RefStr As String
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim I As Long

    Set WB = ActiveWorkbook
    Set WS = ActiveSheet

    Set SD = CreateObject("Scripting.dictionary")
    RefStr = ""    'Value stored in dictionary

    For Each WS In WB.Worksheets
        Select Case WS.Name
        Case "WC170122", "WC240122", "WC310122", "WC070222", "WC140222"
            Set Rng = WS.Range("A7:A" & WS.Range("A" & WS.Rows.Count).End(xlUp).Row)
            For Each R In Rng
                KeyStr = R.Value    'Search Key stored in dictionary
                If Not SD.Exists(KeyStr) Then    'Unique key value, not already in the dictionary
                    SD.Add KeyStr, RefStr
                End If
            Next R
        End Select
    Next WS

    Set WS = WB.Worksheets("Sheet1")
    WS.Range("A3:G300").ClearContents

    With WS.Range("A3")
        For I = 0 To SD.Count - 1
            .Offset(I).Value = SD.keys()(I)
        Next I
    End With
End Sub