Macro for merging rows

[rsklhm]

I have a fairly large spreadsheet that are sorted based on a file # (ie:
E0800100, E0800101). The spreadsheet is setup to where each entry is on an
individual row as seen below:

A B C
E0800100 Review.... 1.0 (hr)
E0800100 Review.... 2.0
E0800101 Review.... 1.5
E0800102 Review.... .5

I am trying to organize the spreadsheet so that there is only one row per
file number and the Descriptions (B) and Time (C) extend along the columns of
that row.

A. B. C.
D. E.
E0800100 Review.... 1.0
Review..... 2.0
E0900101 Review.... 1.5
E0900102 Review... .5

The spreadsheet is not consistent in that there are 2 or 3 entries for every
file number but ranges from 1-15 entries. I attempted to combine various
macro formulas I've seen but have had no such luck and am at a loss to if
this is possible. Any information or direction to getting this as close as
possible would be appreciated.

 

[Wouter HM]

Hi rsklhm

Using Excel 2003 I have created this:

Sub MergeOnColumnA()
Dim lastRow As Long
Dim loopRow As Long

lastRow = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row + 1

loopRow = ActiveCell.Row
Do While loopRow < lastRow
Cells(loopRow, 1).Select
If Cells(loopRow, 1).Value = Cells(loopRow - 1, 1).Value Then
Cells(loopRow - 1, 1).End(xlToRight).Offset(0, 1).Value = _
Cells(loopRow, 2)
Cells(loopRow - 1, 1).End(xlToRight).Offset(0, 1).Value = _
Cells(loopRow, 3)
Rows(loopRow).Delete
lastRow = lastRow - 1
Else
loopRow = loopRow + 1
End If
Loop

End Sub

HTH,

Wouter

 

[helene and gabor]

Hello Wouter,

I have tried your program and think that the fifth line of:
loopRow=ActiveCell.Row
should be replaced with:

loopRow=2

Best Regards,

Gabor Sebo

 

[helene and gabor]

e0800100 review 3.5 e0800100 review 3.5
review 4.5 e0800100 review 4.5
review 5.5 e0800100 review 5.5
e0800101 review 2.5 e0800101 review 2.5
review 2.5 e0800101 review 2.5
review 3.5 e0800101 review 3.5
review 52.5 e0800101 review 52.5
e0800201 review 52.5 e0800201 review 52.5
e0800202 review 52.5 e0800202 review 52.5
e0800402 review 52.5 e0800402 review 52.5
review 52.5 e0800402 review 52.5
review 52.5 e0800402 review 52.5
review 52.5 e0800402 review 52.5

OUTPUT INPUT


'Hi rsklhm



Sub MergeOnColumnA()
Dim lastRow As Long
Dim loopRow As Long
Dim i As Integer
Dim last As String

lastRow = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row + 1

For i = 2 To lastRow
If i = 2 Then
last = Cells(i - 1, 1).Value
End If

If Cells(i, 1) = last Or Cells(i, 1) = Cells(i - 1, 1).Value Then

Cells(i, 1) = Cells(i, 2).Value
Cells(i, 2) = Cells(i, 3).Value
Cells(i, 3) = ""
End If

If Cells(i, 3) <> "" Then
last = Cells(i, 1).Value
End If
Next i
End Sub



Hello,

Input, output and program attached.

Best Regards

Gabor Sebo
news:[email protected]...

 

[Don Guillett]

Assumes you have sorted first
'=======
Option Explicit
Sub lineemupSAS()
Dim i As Long
Dim lc As Long
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(i - 1, 1) = Cells(i, 1) Then
lc = Cells(i - 1, Columns.Count).End(xlToLeft).Column + 1
Cells(i - 1, lc) = Cells(i, 2)
Cells(i - 1, lc + 1) = Cells(i, 3)
Rows(i).Delete
End If
Next i
End Sub
'=========