none
Do sort and remove duplicates for all sheets as if they are one sheet. RRS feed

  • Question

  • Hello everyone, 

    I have an excel document with data flowing across sheets (20 columns x millions of rows) with the header in 1st sheet only. What I'm looking for is to have a code or a method to treat all these data at once for sorting then removing duplicates from all sheets. Also is there a way to pivot these data for calculation.

    Appreciate your help.

    Thank you, 

    Ahmed

    Wednesday, April 3, 2019 6:55 AM

All replies

  • Hi,

    Use this code for Remove duplicate and sort each worksheet

                        

    Sub SortAndRemoveDuplicate()

    Dim Sht As Worksheet
    Dim ShtIndex As Long

    Dim RangeTable As Range
    Dim RangeKey1 As Range
    Dim LastRow As Long
    Dim LastCol As Long
    Dim FirstRowOfData As Long

    Const KeyColForDuplicate As Long = 1
    Dim FirstRowKey As Long
    Dim HeaderRow As Long



    Application.ScreenUpdating = False


    For Each Sht In ThisWorkbook.Sheets
        ShtIndex = ShtIndex + 1

        LastRow = Sht.Cells.SpecialCells(xlCellTypeLastCell).Row
        LastCol = Sht.Cells.SpecialCells(xlCellTypeLastCell).Column

        Set RangeTable = Range(Sht.Cells(1, 1), Sht.Cells(LastRow, LastCol))

        If ShtIndex = 1 Then
            HeaderRow = 1
            FirstRowKey = 2 'There is header in row 1
        Else
            FirstRowKey = 1
            HeaderRow = 2
        End If

        Set RangeKey1 = Range(Sht.Cells(FirstRowKey, KeyColForDuplicate), Sht.Cells(LastRow, KeyColForDuplicate))

        With RangeTable
            .RemoveDuplicates Columns:=Array(KeyColForDuplicate), Header:=HeaderRow
            With Sht.Sort
                .SortFields.Clear
                .SortFields.Add2 Key:=RangeKey1, Order:=xlAscending
                .SetRange RangeTable
                .Header = HeaderRow
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                 .Apply
            End With
        End With
    Next

    Set RangeTable = Nothing
    Set RangeKey1 = Nothing

    Application.ScreenUpdating = True

    End Sub

    For consolidating data you can use power query, old pivot table wizard (Supports multi ranges) or write a code for this  


    Guy Zommer

    Wednesday, April 3, 2019 12:29 PM
  • Hello Guy, 

    I've added the code into a module, and got this error 438 error: object doesn't support property or method.

    Also, just to clarify, this need to find duplicate in all sheets as if they are single sheet, not for every sheet.

    Also, it may be required to do custom sort with columns 1, 2, 3, 4, and 6 ascending.

    Final request is to have custom remove duplicate (selection of column 3 only)

    Thank you for your help.

    Ahmed.


    Wednesday, April 3, 2019 1:09 PM
  • Hi,

    Sub Consolidate()

    Application.ScreenUpdating = False

    Dim RangeToCopy As Range
    Dim TargetRange As Range
    Dim ShtCounter As Long
    Dim Sht As Worksheet
    Dim LastRowTarget As Long
    Dim LastRowSht As Long

    Const LastCol As Long = 6
    Const DuplicateCol As Long = 3


    Dim SummarySheet As Worksheet
    Set SummarySheet = Worksheets.Add

    For Each Sht In ThisWorkbook.Sheets
        If Sht.Name <> SummarySheet.Name Then
            ShtCounter = ShtCounter + 1
            LastRowTarget = SummarySheet.Cells(Rows.Count, 1).End(xlUp).Row
            
            If LastRowTarget > 1 Then
                LastRowTarget = LastRowTarget + 1
            End If
                
            LastRowSht = Sht.Cells(Rows.Count, 1).End(xlUp).Row
            If ShtCounter = 1 Then
                Set RangeToCopy = Range(Sht.Cells(1, 1), Sht.Cells(LastRowSht, LastCol))
            Else
                Set RangeToCopy = Range(Sht.Cells(2, 1), Sht.Cells(LastRowSht, LastCol))
            End If
            
            RangeToCopy.Copy
            SummarySheet.Cells(LastRowTarget, 1).PasteSpecial xlPasteValues
            
        End If
    Next

    LastRowTarget = SummarySheet.Cells(Rows.Count, 1).End(xlUp).Row

    Set TargetRange = Range(Cells(1, 1), Cells(LastRowTarget, LastCol))

    TargetRange.RemoveDuplicates Columns:=3, Header:=xlYes

    With SummarySheet.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=Range("A2:A" & LastRowTarget & ""), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add2 Key:=Range("B2:B" & LastRowTarget & ""), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add2 Key:=Range("C2:C" & LastRowTarget & ""), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add2 Key:=Range("D2:D" & LastRowTarget & ""), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add2 Key:=Range("F2:F" & LastRowTarget & ""), SortOn:=xlSortOnValues, Order:=xlDescending
        
        .SetRange TargetRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
       
    End With

    Application.CutCopyMode = False
    Cells(1, 1).Select

    Set TargetRange = Nothing
    Set RangeToCopy = Nothing
    Set SummarySheet = Nothing
    Application.ScreenUpdating = True



    End Sub



    Guy Zommer

    Thursday, April 4, 2019 9:29 AM
  • Hi Guy, 

    Actually still not working, below screenshoots from the code.

    Thursday, April 4, 2019 1:10 PM
  • Hi,

    Which version of Excel do you have?


    Guy Zommer

    Thursday, April 4, 2019 1:12 PM
  • Try to save the file as xlsx

    Guy Zommer

    Thursday, April 4, 2019 1:13 PM
  • 2016, and the file is already xlsx

    Thursday, April 4, 2019 1:23 PM
  • Hi Guy, 

    Let me clarify the setting, may be something is causing this error:

    The report has header in first sheet only, data are flowing to next sheet without header

    I've also removed report 2 and 3 to avoid any interference but still same error appearing.!

    Thursday, April 4, 2019 1:42 PM
  • Hi,

    You don't have place in the worksheet you have reached the last row in the worksheet


    Guy Zommer

    Thursday, April 4, 2019 1:45 PM
  • Hi,

    Yes, this the issue I'm facing. What do you recommend to handle such huge data?

    Ahmed.

    Thursday, April 4, 2019 1:51 PM