Macro to create unique list

[MOB]

Hi

I have a spreadsheet with 5 tabs - wk1 to wk5

I also have a summary page tab.

Wk1 - Wk5 tabs contain data from cell A7 downwards

I need a macro to take the data from cell A7 downwards on each of the 5 WK tabs, and paste a unique list of all of this data in the summary page tab from cell 7 downwards.

Any help on this would be much appreciated!!

Thanks

 

[StephenR]

I would start by looking at Advanced Filter and copying them to the summary sheet and selecting the unique records only box. Record a macro and come back if/when you get stuck. Probably need a loop to go through each of the five sheets.

 

[xld]

Public Sub ProcessData()
Dim i As Long
Dim iLastRow As Long
Dim iRow As Long

    iRow = 1
    For i = 1 To 5
    
        With Worksheets("Wk" & i)
        
            iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Rows("7:" & iLastRow).Copy Worksheets("Master").Range("A" & iRow)
        End With
        
        iRow = iRow + iLastRow - 6
        
    Next i
    
    With Worksheets("Master")
        iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = iLastRow To 2 Step -1
            If Not IsError(Application.Match(.Cells(i, "A").Value, .Range("A1").Resize(i - 1), 0)) Then
                .Rows(i).Delete
            End If
        Next i
    End With
End Sub

 

[jindon]

Sub test()
Dim ws As Worksheet, a, e, n(), n As Long
ReDim b(1 To Rows.Count, 1 To 1)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For Each ws In Worksheets
        If ws.Name <> "summary" Then
            a = ws.Range("a7", ws.Range("a" & Rows.Count).End(xlUp)).Value
           For Each e In a
               If Not IsEmpty(e) And Not .exists(e) Then
                   n = n + 1 : b(n,1) = e
                   .add, e, Nothing
               End If
           Next
        End If
    Next
End With
With Sheets("summary")
    .Range("a7", .Range("a" & Rows.Count).ClearContents
    .Range("a7").Resize(n).Value = b
End With
End Sub

 

[MOB]

Thanks for the replies

XLD - nearly works, I just need the data from column A returning to column A on the summary tab, it seems to be returning 7 columns I think. Also on the summary tab it is starting at cell A1 - I need it to start from cell A7

Jindon - I'm getting a Compile error duplication declaration in current scope

 

[Richard Schollar]

Hi

I think Jindo just had a typo and an unused variable:

Sub test() 
Dim ws As Worksheet, a, e, n As Long 
ReDim b(1 To Rows.Count, 1 To 1) 
With CreateObject("Scripting.Dictionary") 
    .CompareMode = vbTextCompare 
    For Each ws In Worksheets 
        If ws.Name <> "summary" Then 
            a = ws.Range("a7", ws.Range("a" & Rows.Count).End(xlUp)).Value 
           For Each e In a 
               If Not IsEmpty(e) And Not .exists(e) Then 
                   n = n + 1 : b(n,1) = e 
                   .add, e, Nothing 
               End If 
           Next 
        End If 
    Next 
End With 
With Sheets("summary") 
    .Range("a7", .Range("a" & Rows.Count)).ClearContents 
    .Range("a7").Resize(n).Value = b 
End With 
End Sub

 

[MOB]

Thanks everyone - got it working!!

 

[jindon]

Thanks Richard

MOB

Change n() to b() in the Dim statement.