Need help combing multiple like rows and including a count

[UPSDuder]

I need to loop through all rows of my data, and consolidate all of the like rows into one row, and include a count of how many versions of that row there where. As you can see below I am trying to consolidate these 5 rows of data into 2, and my code does nothing of the sort, Can someone point me in the right direction?

Consolidate this data:

District Name	Center Num	Center Name	Acct Facility Name	Acct Facility Loc Num
RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	854
RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	855
RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	854
RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	855
RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	854

<tbody>
</tbody>

Into:

District Name	Center Num	Center Name	Acct Facility Name	Acct Facilit Loc Num	Count
RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	854	3
RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	855	2

<tbody>
</tbody>

Sub DelCount()
Dim xlBook As Workbook
Dim xlSheet As Worksheet
'Setup references to workbook and sheet
Set xlBook = ActiveWorkbook
Set xlSheet = xlBook.Sheets("Deliveries")
Dim RowNum As Long
Dim LastRow As Long
Application.ScreenUpdating = False
'start below titles and make full selection of data
RowNum = 2
LastRow = xlSheet.Cells(Rows.Count, "A").End(xlUp).Row
xlSheet.Range("A2", Cells(LastRow, 10)).Select
'For loop for all rows in selection with cells
For Each Row In Selection
    With Cells
    'if account number matches
    If Cells(RowNum, 9).Value = Cells(RowNum + 1, 9).Value Then
        'Increase count of deliveries by 1 for each matching row
            Cells(RowNum + 1, 10).Value = Cells(RowNum + 1, 10).Value + 1
        'Copy the increased value upto top line
            Cells(RowNum + 1, 10).Copy Destination:=Cells(RowNum, 10)
            Rows(RowNum + 1).EntireRow.Delete
     End If
     
    End With
'increase rownum for next test
RowNum = RowNum + 1
Next Row
'turn on screen updating
Application.ScreenUpdating = True
End Sub

 

[Fluff]

How about

Sub UPSDuder()
   Dim Cl As Range, Rng As Range
   Dim ValU As String
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.count).End(xlUp))
         ValU = join(Application.Index(Cl.Resize(, 5).Value, 1, 0), "|")
         If Not .Exists(ValU) Then
            .Add ValU, Cl.Offset(, 5)
            Cl.Offset(, 5) = 1
         Else
            .Item(ValU).Value = .Item(ValU).Value + 1
            If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
         End If
      Next Cl
   End With
   If Not Rng Is Nothing Then Rng.EntireRow.Delete
End Sub

 

[GR00007]

Here's one way of doing what you want without VBA.
Sort on all five columns and add a count and sequence column. The count goes from total down to one, the sequence goes from one to total.
Just filter on sequence of 1 and you have your result.

District Name	Center Num	Center Name	Acct Facility Name	Acct Facility Loc Num	Kt	Seq
RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	854	3	1
RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	854	2	2
RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	854	1	3
RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	855	2	1
RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	855	1	2

<tbody>
</tbody>

In F2 put this formula and copy down

=IF(A2&B2&C2&D2&E2=A3&B3&C3&D3&E3,F3+1,1)

in G2 put this formula and copy down

=IF(A2&B2&C2&D2&E2=A1&B1&C1&D1&E1,G1+1,1)

 

[UPSDuder]

Fluff,

Thankyou for your answer, your VBA skills are far beyond mine, and I may need a little clarity if I have overwritten something I should not have.

The data I am testing actually has a few more columns, I have added a deliveries column with a value of 1.

I am wanting to focus on Column "I" or Acct Facility Loc Num, this has the data I am wanting to compare for the Row. ​

I believe I modified your code to only look at column "I" as that contains the value I am wanting to count. And then place the Count in Column "J", it seems to work, but I'm not 100% confident I have all aspects correct.

Pkg Barcode Num	Region Num	Region Name	District Num	District Name	Center Num	Center Name	Acct Facility Name	Acct Facility Loc Num	Deliveries
1Z129W000359443460	03	WEST REGION	12	RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	854	4
1Z129W000359443463	03	WEST REGION	12	RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	855	7

<colgroup><col><col><col><col span="3"><col span="2"><col span="2"></colgroup><tbody>
</tbody>

Sub UPSDuder()
   Dim Cl As Range, Rng As Range
   Dim ValU As String
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("I2", Range("I" & Rows.Count).End(xlUp))
         ValU = Join(Application.Index(Cl.Resize(, 9).Value, 1, 0), "|")
         If Not .Exists(ValU) Then
            .Add ValU, Cl.Offset(, 1)
            Cl.Offset(, 1) = 1
         Else
            .Item(ValU).Value = .Item(ValU).Value + 1
            If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
         End If
      Next Cl
   End With
   If Not Rng Is Nothing Then Rng.EntireRow.Delete
End Sub

 

[UPSDuder]

Here's one way of doing what you want without VBA.
Sort on all five columns and add a count and sequence column. The count goes from total down to one, the sequence goes from one to total.
Just filter on sequence of 1 and you have your result.

District Name	Center Num	Center Name	Acct Facility Name	Acct Facility Loc Num	Kt	Seq
RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	854	3	1
RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	854	2	2
RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	854	1	3
RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	855	2	1
RED RIVER	7738	WBK - WOODLANDS	WILLIAMS-SONOMA	855	1	2

<tbody>
</tbody>

In F2 put this formula and copy down

=IF(A2&B2&C2&D2&E2=A3&B3&C3&D3&E3,F3+1,1)

in G2 put this formula and copy down

=IF(A2&B2&C2&D2&E2=A1&B1&C1&D1&E1,G1+1,1)

GR00007,

Thank you for answer, but I believe VBA will be my best solution, as I will be working with much heavier data sets with many more steps to follow, and I will be replacing the data set daily.

 

[Fluff]

If you are only interested in Col I then use this

Sub UPSDuder()
   Dim Cl As Range, Rng As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("I2", Range("I" & Rows.count).End(xlUp))
         If Not .Exists(Cl.Value) Then
            .Add Cl.Value, Cl.Offset(, 1)
            Cl.Offset(, 1) = 1
         Else
            .Item(Cl.Value).Value = .Item(Cl.Value).Value + 1
            If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
         End If
      Next Cl
   End With
   If Not Rng Is Nothing Then Rng.EntireRow.Delete
End Sub

 

[UPSDuder]

It works wonderfully, Thank you

 

[Fluff]

You're welcome & thanks for the feedback