combine rows with duplicate values and get total count of duplicate

[PA_VA13]

Hi sorry that my data is not in XL2BB but I still have not figured out why it stopped working on my PC.

I am trying to figure out how to create a button that would combine rows B-F dependent on the duplicate values in column B into a single row in columns H-M, but also I want the code to count the total number of times the value in column B is duplicated into another column labeled "# Blocks" in column I.

I have not been able to find any tutorials on how to do this.

Note: (column B data is created by the formula =LEFT(A2,MIN(--(FIND(CHAR(ROW($65:$90)),A2&CHAR(ROW($65:$90)),3)))-1) with data taken from column A).


I want to take the initial data

and condense it into this format

 

[C Moore]

Do you have office 365? If so, use countif in the first table in the # Blocks column. In another space use UNIQUE function to summarize.

 

[sandy666]

@C Moore

XL2010 does no;t contain UNIQUE()

 

[C Moore]

Then it needs the complex unique formula returns. Lots of examples if you google unique list formula or something similar.

 

[Peter_SSs]

See if this is on the right track. It assumes #Blocks column is empty to start with as shown in your image

Sub Combine_Rows()
  Dim d As Object
  Dim a As Variant
  Dim s As String
  Dim i As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  a = Range("B2", Range("B" & Rows.Count).End(xlUp)).Resize(, 5).Value
  For i = 1 To UBound(a)
    s = Join(Application.Index(a, i, 0), ";")
    d(s) = d(s) + 1
  Next i
  With Range("H2").Resize(d.Count)
    .Value = Application.Transpose(d.Keys)
    .TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False
    .Offset(, 1).Value = Application.Transpose(d.Items)
  End With
End Sub

 

[PA_VA13]

See if this is on the right track. It assumes #Blocks column is empty to start with as shown in your image

Sub Combine_Rows()
  Dim d As Object
  Dim a As Variant
  Dim s As String
  Dim i As Long
 
  Set d = CreateObject("Scripting.Dictionary")
  a = Range("B2", Range("B" & Rows.Count).End(xlUp)).Resize(, 5).Value
  For i = 1 To UBound(a)
    s = Join(Application.Index(a, i, 0), ";")
    d(s) = d(s) + 1
  Next i
  With Range("H2").Resize(d.Count)
    .Value = Application.Transpose(d.Keys)
    .TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False
    .Offset(, 1).Value = Application.Transpose(d.Items)
  End With
End Sub

Finally got a chance at work to try out the code you sent. I did receive a Run-time error '13': Type mismatch. The debug shows that it is line s = Join(Application.Index(a, i, 0), ";"). Is this one of those instances where you need to use a loop to populate the array?

 

[Peter_SSs]

Is this one of those instances where you need to use a loop to populate the array?

It shouldn't be, and it worked for me with my test data as is. So more likely the problem is the type and/or location of the data.

Any chance you could provide a small set of sample data where the code fails with XL2BB so that we can easily copy it to be sure that we are working with the same data as you?

Did you make any changes at all to the code? If so, please also provide the code you used when it errored.

 

[PA_VA13]

It shouldn't be, and it worked for me with my test data as is. So more likely the problem is the type and/or location of the data.

Any chance you could provide a small set of sample data where the code fails with XL2BB so that we can easily copy it to be sure that we are working with the same data as you?

Did you make any changes at all to the code? If so, please also provide the code you used when it errored.

I did not change any of the code, and it only seems to have issues with the s = Join(Application.Index(a, i, 0), ";") part of the code. Can you explain what that part is supposed to do? I'm still learning VBA coding and that is new coding to me. Perhaps there is something in formula in column B that is messing it up. The formula in column B is =LEFT(A2,MIN(--(FIND(CHAR(ROW($65:$90)),A2&CHAR(ROW($65:$90)),3)))-1)

 

[Peter_SSs]

You will get that error if there are any error values resulting from your column B formula. One way that would happen is if you have any cells in column A that contain less that 2 characters.
Could that be the problem? If so, what do you want to happen if there is any data in columns D:F for those rows.

s = Join(Application.Index(a, i, 0), ";") part of the code. Can you explain what that part is supposed to do?

That takes one row (i) from columns B:F and joins all the values into a string separated by semicolons. So for the first row in the post 1 sample, you would get

s = "SP-20-3945.1;;R;COLON;SS"

 

[PA_VA13]

You will get that error if there are any error values resulting from your column B formula. One way that would happen is if you have any cells in column A that contain less that 2 characters.
Could that be the problem? If so, what do you want to happen if there is any data in columns D:F for those rows.


That takes one row (i) from columns B:F and joins all the values into a string separated by semicolons. So for the first row in the post 1 sample, you would get

s = "SP-20-3945.1;;R;COLON;SS"

It's been a bit since I have had time at work to continue working on this project but since I actually had time today I removed the code you sent me from the worksheet and then just re-added it. No change to the code at all. I'm beginning to think that mt PC has gremlins as the debug now show that there is an issue with the line below and no longer an issue with Join(Application) line. ?

.TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False