Copy Multiple sheet into new Sheet without duplicates and with auto filter

[p9326]

Hello. I am fairly new to VBA. I have a workbook name VBA test data sort with sheetname (Consolidated, RM WIP, Drying), all I want is to copy the 2 sheets (or maybe more additional sheets in the future) to consolidated sheets and remove duplicates since the 2 sheets will be the storage or data upload bt the end user.

1. copy 2 sheets into new sheets -Formula below - this is working but everytime i click my command button its continue copy everything in my consolidated.

Sub TEST()
Dim ws As Worksheet, lr As Long
lr = Sheets("Consolidated").Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each ws In Worksheets
If ws.Name <> "Consolidated" Then
ws.Range("A2:K100000").Copy Sheets("Consolidated").Range("A" & lr)
lr = Sheets("Consolidated").Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
Next ws
End Sub



2. Remove duplicates everytime i click the command button
3. auto filter, since my file base will be In and Out from C, A, B

 

[Siddharth Rout]

this is working but everytime i click my command button its continue copy everything in my consolidated.

Do you want to clear the consolidated sheet and then copy the fresh data from all worksheets? If you do not clear, then everytime you click on the button, the data will be copied again?

 

[Siddharth Rout]

Here is what I mean. Also as per your screenshot, the data is in cols A to C?

Is this what you are trying?

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim wsCon As Worksheet
    Dim lr As Long: lr = 2
    Dim wsLR As Long
    
    '~~> This is your Consolidated worksheet
    Set wsCon = ThisWorkbook.Sheets("Consolidated")
    wsCon.AutoFilterMode = False
    
    '~~> Clear the contents for input
    wsCon.Range("A2:C" & wsCon.Rows.Count).ClearContents
    
    '~~> Copy the data in to the Consolidated worksheet from other sheets
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> wsCon.Name Then
            wsLR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
            
            ws.Range("A2:C" & wsLR).Copy wsCon.Range("A" & lr)
            
            lr = wsCon.Range("A" & wsCon.Rows.Count).End(xlUp).Row + 1
        End If
    Next ws
    
    With wsCon
        '~~> Remove duplicates
        .Range("A1:C" & lr).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
        '~~> Apply filter in row 1
        .Range("A1:C1").AutoFilter
    End With
End Sub

 

[p9326]

yehey @Siddharth Rout thank you very much

 

[p9326]

@Siddharth Rout i would like to add the Column C to auto sort Descending / Assend? It's that possible? thank you

 

[p9326]

I Solve my question.

On Error Resume Next
If Not Intersect(Target, Range("C:C")) Is Nothing Then
Range("C1").Sort Key1:=Range("C2"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End Sub



now my problem how can I highlighted the entire row when A2 start with I or IN / O or Out at the beginning.

 

[Siddharth Rout]

LOL so many questions

Let's tackle them one by one.

Column C to auto sort

To sort in Ascending, simply use the code as shown below

With wsCon
    lr = .Range("A" & .Rows.Count).End(xlUp).Row
   
    '~~> Sort the range
    .Range("A1:C" & lr).Sort Key1:=.Range("C2"), _
                    Order1:=xlAscending, _
                    Header:=xlYes, _
                    OrderCustom:=1, _
                    MatchCase:=False, _
                    Orientation:=xlTopToBottom, _
                    DataOption1:=xlSortNormal
End With

now my problem how can I highlighted the entire row when A2 start with I or IN / O or Out at the beginning.

Here, the best way to handle it is to use Conditional Formattting. I will show you how to use conditional formatting for cells which shart with I or O. Feel free to adjust it to include other criteria. BTW I am using light blue color to highlight. Feel free to change the color.

    With wsCon
        lr = .Range("A" & .Rows.Count).End(xlUp).Row
       
        '~~> Apply conditional formatting
        With .Range("A1:C" & lr)
            .FormatConditions.Delete

            .FormatConditions.Add Type:=xlExpression, _
                                  Formula1:="=OR(LEFT($A1,1)=""I"",LEFT($A1,1)=""O"")"
       
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
           
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent1
                .TintAndShade = 0.399945066682943
            End With
           
            .FormatConditions(1).StopIfTrue = False
        End With
    End With

So if I combine these two pieces of the code with the main code then it will look like this (UNTESTED)

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim wsCon As Worksheet
    Dim lr As Long: lr = 2
    Dim wsLR As Long
   
    '~~> This is your Consolidated worksheet
    Set wsCon = ThisWorkbook.Sheets("Consolidated")
    wsCon.AutoFilterMode = False
   
    '~~> Clear the contents for input
    wsCon.Range("A2:C" & wsCon.Rows.Count).ClearContents
   
    '~~> Copy the data in to the Consolidated worksheet from other sheets
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> wsCon.Name Then
            wsLR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
           
            ws.Range("A2:C" & wsLR).Copy wsCon.Range("A" & lr)
           
            lr = wsCon.Range("A" & wsCon.Rows.Count).End(xlUp).Row + 1
        End If
    Next ws
   
    With wsCon
        '~~> Remove duplicates
        .Range("A1:C" & lr).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
       
        lr = .Range("A" & .Rows.Count).End(xlUp).Row
       
        '~~> Sort the range
        .Range("A1:C" & lr).Sort Key1:=.Range("C2"), _
                        Order1:=xlAscending, _
                        Header:=xlYes, _
                        OrderCustom:=1, _
                        MatchCase:=False, _
                        Orientation:=xlTopToBottom, _
                        DataOption1:=xlSortNormal

        '~~> Apply conditional formatting
        With .Range("A1:C" & lr)
            .FormatConditions.Delete
           
            .FormatConditions.Add Type:=xlExpression, _
                                  Formula1:="=OR(LEFT($A1,1)=""I"",LEFT($A1,1)=""O"")"
       
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
           
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent1
                .TintAndShade = 0.399945066682943
            End With
           
            .FormatConditions(1).StopIfTrue = False
        End With
       
        '~~> Apply filter in row 1
        .Range("A1:C1").AutoFilter
    End With
End Sub

PS: Remember. If you get stuck record a macro

 

[p9326]

Thank you @Siddharth Rout, you're the man,

but when I click all my data only 1 color (purple). how can I identify the in (blue) and out (green)


This code I put

Sub Macro2()
Dim a As Variant, r As Range, lr As Long, i As Long
lr = Range("A" & Rows.Count).End(3).Row
Set r = Range("A" & lr + 1)
a = Range("A1:A" & lr).Value2
For i = 1 To UBound(a)
If LCase(a(i, 1)) Like "*o-*" Then Set r = Union(r, Range("A" & i, Range("C" & i)))
Next
r.Interior.Color = RGB(0, 204, 255)
Range("A" & lr + 1).Interior.Color = xlNone


lr = Range("A" & Rows.Count).End(3).Row
Set r = Range("A" & lr + 1)
a = Range("A1:A" & lr).Value2
For i = 1 To UBound(a)
If LCase(a(i, 1)) Like "*i-*" Then Set r = Union(r, Range("A" & i, Range("C" & i)))
Next
r.Interior.Color = RGB(0, 255, 0)
Range("A" & lr + 1).Interior.Color = xlNone

End Sub

 

[Siddharth Rout]

Thank you @Siddharth Rout, you're the man,

but when I click all my data only 1 color (purple). how can I identify the in (blue) and out (green)


This code I put

Sub Macro2()
Dim a As Variant, r As Range, lr As Long, i As Long
lr = Range("A" & Rows.Count).End(3).Row
Set r = Range("A" & lr + 1)
a = Range("A1:A" & lr).Value2
For i = 1 To UBound(a)
If LCase(a(i, 1)) Like "*o-*" Then Set r = Union(r, Range("A" & i, Range("C" & i)))
Next
r.Interior.Color = RGB(0, 204, 255)
Range("A" & lr + 1).Interior.Color = xlNone


lr = Range("A" & Rows.Count).End(3).Row
Set r = Range("A" & lr + 1)
a = Range("A1:A" & lr).Value2
For i = 1 To UBound(a)
If LCase(a(i, 1)) Like "*i-*" Then Set r = Union(r, Range("A" & i, Range("C" & i)))
Next
r.Interior.Color = RGB(0, 255, 0)
Range("A" & lr + 1).Interior.Color = xlNone

End Sub

You have to set different conditional formatting rules. First do it manually and get the desired result. Once you are happy, record a macro and you will get the code. Simply edit the code to suit your requirments