Consolidate different worksheets in one and delete duplicates

[vinzent]

Hello
I am doing a macro to get some information, but I have next problem on this part:
I want to consolidate the column A from multiple worksheets in one worksheet (CONSOLIDATED TAB) but I have a problem due the the sheets contain different names and the information to consolidate starting when the title is "Cost Elements" until the end and I need to remove duplicated only to show one consolidate list and delete the rows showing "Debit" and "Over/Under"
If can help me with this will be great excellent. Thank You

 

[DanteAmor]

I have some doubts,
how many columns are going to be consolidated? only column "A"?
the data "Debit" and "Over/Under" are in column "A"?

 

[vinzent]

I have some doubts,
how many columns are going to be consolidated? only column "A"?
the data "Debit" and "Over/Under" are in column "A"?

Yes, only the column to consolidate is "A" and both words are in column "A"

 

[DanteAmor]

Try this:

Sub consolidate_A()
  Dim dic As Object
  Dim i As Long, j As Long, k As Long, lr As Long
  Dim a() As Variant, b As Variant
  Dim sh As Worksheet, shc As Worksheet
  Dim f As Range
  
  Set shc = Sheets("CONSOLIDATED")
  Set dic = CreateObject("Scripting.Dictionary")
  dic.comparemode = vbTextCompare
  For Each sh In Sheets
    lr = lr + sh.Range("A" & Rows.Count).End(3).Row
  Next
  ReDim b(1 To lr, 1 To Columns("A").Column)    '
  shc.Cells.ClearContents
  
  For Each sh In Sheets
    Select Case sh.Name
      Case shc.Name, "report", "etc"  'fit sheet names that don't go in consolidation
      Case Else
        Erase a
        Set f = sh.Range("A:A").Find("Cost Elements", , xlValues, xlWhole, , , False)
        If Not f Is Nothing Then
          a = sh.Range("A" & f.Row + 1, sh.Cells(sh.Range("A" & Rows.Count).End(3).Row + 3, UBound(b, 2))).Value
          For i = 1 To UBound(a, 1)
            If a(i, 1) <> "" And a(i, 1) <> "Debit" And a(i, 1) <> "Over/Under" Then
              If Not dic.exists(a(i, 1)) Then
                dic(a(i, 1)) = Empty
                k = k + 1
                For j = 1 To UBound(a, 2)
                  b(k, j) = a(i, j)
                Next
              End If
            End If
          Next
        End If
    End Select
  Next
  shc.Range("A2").Resize(k, UBound(b, 2)).Value = b
End Sub

 

[vinzent]

Try this:

Sub consolidate_A()
  Dim dic As Object
  Dim i As Long, j As Long, k As Long, lr As Long
  Dim a() As Variant, b As Variant
  Dim sh As Worksheet, shc As Worksheet
  Dim f As Range
 
  Set shc = Sheets("CONSOLIDATED")
  Set dic = CreateObject("Scripting.Dictionary")
  dic.comparemode = vbTextCompare
  For Each sh In Sheets
    lr = lr + sh.Range("A" & Rows.Count).End(3).Row
  Next
  ReDim b(1 To lr, 1 To Columns("A").Column)    '
  shc.Cells.ClearContents
 
  For Each sh In Sheets
    Select Case sh.Name
      Case shc.Name, "report", "etc"  'fit sheet names that don't go in consolidation
      Case Else
        Erase a
        Set f = sh.Range("A:A").Find("Cost Elements", , xlValues, xlWhole, , , False)
        If Not f Is Nothing Then
          a = sh.Range("A" & f.Row + 1, sh.Cells(sh.Range("A" & Rows.Count).End(3).Row + 3, UBound(b, 2))).Value
          For i = 1 To UBound(a, 1)
            If a(i, 1) <> "" And a(i, 1) <> "Debit" And a(i, 1) <> "Over/Under" Then
              If Not dic.exists(a(i, 1)) Then
                dic(a(i, 1)) = Empty
                k = k + 1
                For j = 1 To UBound(a, 2)
                  b(k, j) = a(i, j)
                Next
              End If
            End If
          Next
        End If
    End Select
  Next
  shc.Range("A2").Resize(k, UBound(b, 2)).Value = b
End Sub

[/QUOTE]

This code is working.. thank you. You are amazing!!

 

[DanteAmor]

Im glad to help you, thanks for the feedback.