VBA/Macro help needed with combine of rows based - Currently relying on 3rd party addon

R

robospike

New Member
Joined
Mar 22, 2016
Messages
22
Hi, I really hope someone can help...

I have an issue currently that I have overcome with a 3rd party add-on. I am sure there is a way to do this with a macro, however my attempts so far have failed. I am hoping someone can prove the power of VBA and Macros and enable the removal of the 3rd party add-on.

Basically the issue is, where there are several rows (that may not directly follow each other) that have the same data in column A but different data in other columns, there is a combine operation required.

Where two (or more) rows contain an identical value in column A, I want to merge the content of Column H and Column K separated with a new line.

Note: There is a header on row 1 and Column K may not always have a value.

eg:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]G
[/TD]
[TD]H
[/TD]
[TD]I
[/TD]
[TD]J
[/TD]
[TD]K
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]ID
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Data1
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Data2
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]111
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]test
[/TD]
[TD][/TD]
[TD][/TD]
[TD]example
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]111
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]fred
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]222
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]test2
[/TD]
[TD][/TD]
[TD][/TD]
[TD]apple
[/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]111
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]james
[/TD]
[TD][/TD]
[TD][/TD]
[TD]bob
[/TD]
[/TR]
</tbody>[/TABLE]

The macro should result in the sheet looking like this:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[TD]C
[/TD]
[TD]D
[/TD]
[TD]E
[/TD]
[TD]F
[/TD]
[TD]G
[/TD]
[TD]H
[/TD]
[TD]I
[/TD]
[TD]J
[/TD]
[TD]K
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]ID
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Data1
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Data2
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]111
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]test
fred
james
[/TD]
[TD][/TD]
[TD][/TD]
[TD]example
bob
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]222[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]test2[/TD]
[TD][/TD]
[TD][/TD]
[TD]apple[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Any thoughts would be greatfully <!--[if gte mso 9]><xml> <o:OfficeDocumentSettings> <o:AllowPNG/> </o:OfficeDocumentSettings> </xml><![endif]-->received.
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
RoboSpike,

This is very possible. Are you wanting the macro to alter your current table or create a new table?

Jeff
 
Upvote 0
Do you want the multiple items in columns H and K to separated by a comma, space, or other?
 
Upvote 0
Hi Jeff,

That's great, I would ideally like it to work on the current sheet and to seperate values by placing them on a new line.
 
Upvote 0
I think this code is very close to what you need. I'm assuming that the table starts in cell A1 with headers in row 1 and the data starts in row 2. If not, you can change the coordinates; look at the red text in the code. This assumes you have no other data around the table. No data below and no data to the right or left. This code will delete the duplicate rows after it combines the values in columns H and K. You should either make a copy of your table or test it on a sample. I tested it here and it worked.

Let me know if this works for you.

Jeff

Code: 
Sub CombineRows()
  Dim Cel As Range
  Dim R As Range
  Dim IDs() As String
  Dim Data1 As String
  Dim Data2 As String
  Dim Found As Boolean
  Dim iCnt As Long
  Dim cID As String
  Dim X As Long
  Dim cc As Range
  Dim RR As Range
  Dim rCnt As Long
  Dim Y As Long
  Dim u As Range
  Dim ubool As Boolean
  
  
  Set R = Range(Range("[COLOR="#FF0000"]A2[/COLOR]"), Range("[COLOR="#FF0000"]A[/COLOR]" & Cells.Rows.Count).End(xlUp))   'Column of Id's
  rCnt = R.Rows.Count                                                   'Count of rows
  ReDim IDs(rCnt)
  
  For Each Cel In R                                                     'Look at all the ID's
    Y = Y + 1                                                           'Row number
    cID = Cel.Value                                                    'Current ID
    If iCnt > 0 Then                                                    'Have we stored this ID before
      Found = False
      For X = 1 To iCnt
        If IDs(X) = cID Then                                            'Does this ID match a stored ID
          Found = True                                                  'Yes
          Exit For
        End If
      Next X
    ElseIf iCnt = 0 Then
      Found = False
    End If
    
    If Found = True Then                                              'This matches a previously stored ID
      If ubool = True Then                                            'Join to delete row later
        Set u = Union(u, Cel)
      Else
        Set u = Cel
        ubool = True
      End If
      
    ElseIf Found = False Then                                                   'This is a new ID
      iCnt = iCnt + 1                                                           'Increment iCnt
      IDs(iCnt) = cID                                                           'Store ID
      
      If Len(Cel.Offset(0, 7).Value) > 0 Then Data1 = Cel.Offset(0, 7).Value    'Column H not empty
      If Len(Cel.Offset(0, 10).Value) > 0 Then Data2 = Cel.Offset(0, 10).Value  'Column K not empty
      If Y + 1 < rCnt Then                                                      'We are not at the next to last row
        Set RR = Range(Cel.Offset(1, 0), Range("[COLOR="#FF0000"]A[/COLOR]" & Cells.Rows.Count).End(xlUp))
      ElseIf Y + 1 = rCnt Then                                                  'We are at the next to last row
        Set RR = Cel.Offset(1, 0)
      End If
      If Y + 1 <= rCnt Then
        For Each cc In RR                                                       'Go find ID's that match the new ID
          If cc.Value = cID Then
            If Len(cc.Offset(0, 7).Value) > 0 Then Data1 = Data1 & Chr(10) & cc.Offset(0, 7).Value    'Column H not empty
            If Len(cc.Offset(0, 10).Value) > 0 Then Data2 = Data2 & Chr(10) & cc.Offset(0, 10).Value  'Column K not empty
          End If
        Next cc
        Cel.Offset(0, 7) = Data1
        Cel.Offset(0, 10) = Data2
      End If
    End If
  Next Cel
  
  If ubool = True Then
    u.EntireRow.Delete
  End If
          
  
  
End Sub
 
Upvote 0
Hi Jeff,

That is amazing, I have just run it with an ~11200 rows and its completed all of the combines and left me with around 200 which look about right. I have to nip out now but will do some testing and get back to you, however its looking really good!!
 
Upvote 0
Hi Jeff, I have run some tests with your code against some data sets, and the same with the 3rd party plugin. I am pleased to report that from what I have seen so far, the output is identical! This has made such a difference. Thanks so much!
 
Upvote 0
I'm glad it helped. I hope with the comments that I added that you can decipher what to do if you need minor changes. Otherwise, just post to this thread and I'll get back to you soon. Cheers!
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
Macro Help - Transposing Some Data from Columns to Rows, Accounting for Duplicate Data
Replies
1
Views
97
Kaper
Kaper
C
  • Solved
Extracting data with VBA macro button from files in designated folder
2 3
Replies
20
Views
708
Micron
M
J
  • Question Question
Combining VBA code together...need help!
Replies
3
Views
378
Fluff
Fluff
M
  • Question Question
VBA Code to copy rows by date from one tab to another / repeat based on new date
Replies
3
Views
544
kevin9999
K
P
  • Question Question
VBA not excluding specific data based on text
Replies
1
Views
395
Rijnsent
Rijnsent

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

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