Need help combing multiple like rows and including a count

U

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:
[TABLE="width: 402"]
<tbody>[TR]
[TD]District Name[/TD]
[TD]Center Num[/TD]
[TD]Center Name[/TD]
[TD]Acct Facility Name[/TD]
[TD]Acct Facility Loc Num[/TD]
[/TR]
[TR]
[TD]RED RIVER[/TD]
[TD]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD]854[/TD]
[/TR]
[TR]
[TD]RED RIVER[/TD]
[TD]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD]855[/TD]
[/TR]
[TR]
[TD]RED RIVER[/TD]
[TD]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD]854[/TD]
[/TR]
[TR]
[TD]RED RIVER[/TD]
[TD]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD]855[/TD]
[/TR]
[TR]
[TD]RED RIVER[/TD]
[TD]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD]854 [/TD]
[/TR]
</tbody>[/TABLE]

Into:

[TABLE="width: 402"]
<tbody>[TR="bgcolor: transparent"]
[TD]District Name[/TD]
[TD]Center Num[/TD]
[TD]Center Name[/TD]
[TD]Acct Facility Name[/TD]
[TD]Acct Facilit Loc Num[/TD]
[TD]Count[/TD]
[/TR]
[TR="bgcolor: transparent"]
[TD]RED RIVER[/TD]
[TD]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD]854[/TD]
[TD]3[/TD]
[/TR]
[TR="bgcolor: transparent"]
[TD]RED RIVER[/TD]
[TD]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD]855[/TD]
[TD]2[/TD]
[/TR]
</tbody>[/TABLE]

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:

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Sort by date Sort by votes
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
 
Upvote 0
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.
[TABLE="class: grid, width: 888"]
<tbody>[TR]
[TD]District Name[/TD]
[TD]Center Num[/TD]
[TD]Center Name[/TD]
[TD]Acct Facility Name[/TD]
[TD]Acct Facility Loc Num[/TD]
[TD]Kt[/TD]
[TD]Seq[/TD]
[/TR]
[TR]
[TD]RED RIVER[/TD]
[TD="align: right"]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD="align: right"]854[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]RED RIVER[/TD]
[TD="align: right"]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD="align: right"]854[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD]RED RIVER[/TD]
[TD="align: right"]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD="align: right"]854[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD]RED RIVER[/TD]
[TD="align: right"]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD="align: right"]855[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]RED RIVER[/TD]
[TD="align: right"]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD="align: right"]855[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]2[/TD]
[/TR]
</tbody>[/TABLE]
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)
 
Upvote 0
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.



[TABLE="width: 827"]
<colgroup><col><col><col><col span="3"><col span="2"><col span="2"></colgroup><tbody>[TR]
[TD]Pkg Barcode Num[/TD]
[TD]Region Num[/TD]
[TD]Region Name[/TD]
[TD]District Num[/TD]
[TD]District Name[/TD]
[TD]Center Num[/TD]
[TD]Center Name[/TD]
[TD]Acct Facility Name[/TD]
[TD]Acct Facility Loc Num[/TD]
[TD]Deliveries [/TD]
[/TR]
[TR]
[TD]1Z129W000359443460[/TD]
[TD]03[/TD]
[TD]WEST REGION[/TD]
[TD]12[/TD]
[TD]RED RIVER[/TD]
[TD]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD]854
[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]1Z129W000359443463[/TD]
[TD]03[/TD]
[TD]WEST REGION[/TD]
[TD]12[/TD]
[TD]RED RIVER[/TD]
[TD]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD]855[/TD]
[TD="align: right"]7[/TD]
[/TR]
</tbody>[/TABLE]

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
 
Upvote 0
GR00007 said:
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.
[TABLE="class: grid, width: 888"]
<tbody>[TR]
[TD]District Name[/TD]
[TD]Center Num[/TD]
[TD]Center Name[/TD]
[TD]Acct Facility Name[/TD]
[TD]Acct Facility Loc Num[/TD]
[TD]Kt[/TD]
[TD]Seq[/TD]
[/TR]
[TR]
[TD]RED RIVER[/TD]
[TD="align: right"]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD="align: right"]854[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]RED RIVER[/TD]
[TD="align: right"]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD="align: right"]854[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD]RED RIVER[/TD]
[TD="align: right"]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD="align: right"]854[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD]RED RIVER[/TD]
[TD="align: right"]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD="align: right"]855[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]RED RIVER[/TD]
[TD="align: right"]7738[/TD]
[TD]WBK - WOODLANDS[/TD]
[TD]WILLIAMS-SONOMA[/TD]
[TD="align: right"]855[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]2[/TD]
[/TR]
</tbody>[/TABLE]
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)
Click to expand...

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.
 
Upvote 0
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
 
Upvote 0
You're welcome & thanks for the feedback
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Compare 2 sheets or ranges (multiple columns) and highlight/count mismatches
Replies
3
Views
1K
Solvap
S

Forum statistics

Threads
1,224,823
Messages
6,181,180
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top