Macro to Combine Multiple Rows into One Row

brunssl2 · #1 01-09-2015, 11:23 AM

Hello - I have a scenario of multiple rows of data being created for a single data identifier. The goal is to combine these multiple rows for a single data identifier into one single row. In my example, I have 17 columns of data attributes (Column A thru Q) and 1 column of data identifier (Column R).

In the attached, you'll noticed the greyed examples that I am trying to combine into one row. I'm looking for a macro to be able to export the result into a new tab.

Any help would be immensely appreciated!

BobBridges · #2 01-10-2015, 04:51 PM

Brunssl2, it sounds as though you want a macro to do the following:

1) Create a new target worksheet.
2) Sort the source worksheet by column 18, if it isn't already. (Col Q, I take it?)
3) Go through the source worksheet row by row, collecting the dates for a single event code. When you come to the end of an event code, write out the combined row in the target worksheet and continue.

You're on the right track; this is a perfect use for a VBA program. But what part of the above do you need help with? Have you ever written in VBA before? Where are you starting?

brunssl2 · #3 01-12-2015, 06:49 AM

Hi BobBridges - that's exactly what I'm looking for (sort by column R - Event Code).

I have no experience writing VBA. When I have language to look at, I'm able to decipher it and adjust to meet any changes, but I've never learned.

BobBridges · #4 01-12-2015, 08:01 AM

Well, are you read to learn?

Here's the thing: If you're looking for someone to just write the program for you, experience suggests that someone here will be willing. But I'm a teach-a-man-to-fish kind of guy, myself; I'll help you learn how to write one for yourself (after which you'll be able to modify it to handle new situations, and write new ones of your own), but not just give you the fish. Which do you prefer? As I said, some folks here don't mind just writing a simple macro for the new guys.

brunssl2 · #5 01-12-2015, 12:26 PM

I appreciate the desire to teach, but a request like this occurs once or twice a year for me so chances are that I will forget how to do this again in 6-8 months from now anyway .... if you're not willing to compile something, then I can understand that as I'm usually in your camp for teaching a man to fish.

macropod · #6 01-12-2015, 10:04 PM

Try the following macro:

Code:

Sub Demo()
Dim lRow As Long, lCol As Long, i As Long, j As Long, SBar As Boolean
With Application
  SBar = .DisplayStatusBar
  .DisplayStatusBar = True
  .ScreenUpdating = False
  .Calculation = xlManual
End With
ThisWorkbook.Worksheets("Sheet1").UsedRange.Copy
ThisWorkbook.Worksheets("Sheet2").Paste Destination:=ThisWorkbook.Worksheets("Sheet2").Range("A1")
With ThisWorkbook.Worksheets("Sheet2").UsedRange
  lRow = .Cells.SpecialCells(xlCellTypeLastCell).Row - 1
  lCol = .Cells.SpecialCells(xlCellTypeLastCell).Column
  For i = lRow To 1 Step -1
    Application.StatusBar = "Processing row " & i
    If .Cells(i, lCol).Value = .Cells(i + 1, lCol).Value Then
      For j = 1 To lCol - 1
        If Len(Trim(.Cells(i, j).Value)) > 0 Then
          .Cells(i + 1, j).Value = .Cells(i, j).Text
          Exit For
        End If
      Next
      .Rows(i).EntireRow.Delete
    End If
  Next
End With
With Application
  .Calculation = xlAutomatic
  .StatusBar = False
  .DisplayStatusBar = SBar
  .ScreenUpdating = True
End With
End Sub

brunssl2 · #7 01-13-2015, 01:00 PM

I've added this macro into my file and it doesn't seem to do anything when I run it

charlesdh · #8 01-13-2015, 01:31 PM

Hi,

I modified Macopod code see if this works.

Code:

Sub Demo()
Dim lRow As Long, lCol As Long, i As Long, j As Long, SBar As Boolean
With Application
  SBar = .DisplayStatusBar
  .DisplayStatusBar = True
  .ScreenUpdating = False
  .Calculation = xlManual
End With
''' changed to this '''
ThisWorkbook.Worksheets("Sheet1").UsedRange.Copy Destination:=ThisWorkbook.Worksheets("Sheet2").Range("A1")
''''''''''''''''''''''''''''''
With ThisWorkbook.Worksheets("Sheet2").UsedRange
  lRow = .Range("R65536").End(xlUp).Row ''' changed this '''
  lCol = .Cells.SpecialCells(xlCellTypeLastCell).Column
  For i = lRow To 1 Step -1
    Application.StatusBar = "Processing row " & i
    If .Cells(i, lCol).Value = .Cells(i + 1, lCol).Value Then
      For j = 1 To lCol - 1
        If Len(Trim(.Cells(i, j).Value)) > 0 Then
          .Cells(i + 1, j).Value = .Cells(i, j).Text
          Exit For
        End If
      Next
      .Rows(i).EntireRow.Delete
    End If
  Next
End With
With Application
  .Calculation = xlAutomatic
  .StatusBar = False
  .DisplayStatusBar = SBar
  .ScreenUpdating = True
End With
End Sub

macropod · #9 01-13-2015, 01:43 PM

The code I posted works fine as is. Do note that I updated it after posting, as I'd initially omitted a couple of lines. If you check Sheet 2 after running the macro, you should see the transformed data there.

brunssl2 · #10 01-13-2015, 01:43 PM

Worked perfectly! Thank you so much!

charlesdh · #11 01-13-2015, 01:56 PM

macropod,

Unless I missed something it did not work for me.
The data was not copied to sheet2.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Combine multiple presentations	stevevrabel	PowerPoint	27	11-23-2014 07:42 AM
Copy Multiple Rows to new workbook when multiple criteria is met.	flds	Excel Programming	5	09-30-2014 09:58 AM
Combine or merge multiple worksheets into one worksheet	timomaha	Excel	1	07-21-2014 01:02 PM
Cross-referencing in multiple documents that will combine to make one report	razberri	Word	1	01-20-2014 01:00 AM
combine multiple documents word starter 2010	bribelge	Word	3	12-19-2012 09:25 AM