Need help combing multiple like rows and including a count

UPSDuder

New Member
Joined
Feb 14, 2019
Messages
10
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 NameCenter NumCenter NameAcct Facility NameAcct Facility Loc Num
RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA854
RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA855
RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA854
RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA855
RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA854

<tbody>
</tbody>

Into:


District NameCenter NumCenter NameAcct Facility NameAcct Facilit Loc NumCount
RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA8543
RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA8552

<tbody>
</tbody>

Code:
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
 
Last edited:

Some videos you may like

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,348
Office Version
  1. 365
Platform
  1. Windows
How about
Code:
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

Board Regular
Joined
Apr 22, 2015
Messages
184
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 NameCenter NumCenter NameAcct Facility NameAcct Facility Loc NumKtSeq
RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA85431
RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA85422
RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA85413
RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA85521
RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA85512

<tbody>
</tbody>
In F2 put this formula and copy down
Code:
=IF(A2&B2&C2&D2&E2=A3&B3&C3&D3&E3,F3+1,1)
in G2 put this formula and copy down
Code:
=IF(A2&B2&C2&D2&E2=A1&B1&C1&D1&E1,G1+1,1)
 

UPSDuder

New Member
Joined
Feb 14, 2019
Messages
10
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 NumRegion NumRegion NameDistrict NumDistrict NameCenter NumCenter NameAcct Facility NameAcct Facility Loc NumDeliveries
1Z129W00035944346003WEST REGION12RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA854
4
1Z129W00035944346303WEST REGION12RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA8557

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

Code:
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

New Member
Joined
Feb 14, 2019
Messages
10

ADVERTISEMENT

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 NameCenter NumCenter NameAcct Facility NameAcct Facility Loc NumKtSeq
RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA85431
RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA85422
RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA85413
RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA85521
RED RIVER7738WBK - WOODLANDSWILLIAMS-SONOMA85512

<tbody>
</tbody>
In F2 put this formula and copy down
Code:
=IF(A2&B2&C2&D2&E2=A3&B3&C3&D3&E3,F3+1,1)
in G2 put this formula and copy down
Code:
=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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,348
Office Version
  1. 365
Platform
  1. Windows
If you are only interested in Col I then use this
Code:
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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,348
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,109,048
Messages
5,526,477
Members
409,702
Latest member
thmoriarty

This Week's Hot Topics

Top