Macro for merging rows

  • Follow


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. 
0
Reply Utf 5/25/2010 6:11:02 PM

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
0
Reply Wouter 5/25/2010 8:10:59 PM


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

----------------------------------------------------------------------------------------------------------------------------------------------------------------------
"Wouter HM" <wouter.magre@sogeti.nl> wrote in message 
news:191be05e-459c-4f05-9dc5-1175c41d3054@w3g2000vbd.googlegroups.com...
> 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 

0
Reply helene 5/26/2010 12:15:52 AM

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
"rsklhm" <rsklhm@discussions.microsoft.com> wrote in message 
news:85E4B28D-F114-4253-A995-AF3902314C4B@microsoft.com... 

0
Reply helene 5/26/2010 12:08:53 PM

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
'=========
-- 
Don Guillett
Microsoft MVP Excel
SalesAid Software
dguillett@gmail.com
"rsklhm" <rsklhm@discussions.microsoft.com> wrote in message 
news:85E4B28D-F114-4253-A995-AF3902314C4B@microsoft.com...
>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. 

0
Reply Don 5/26/2010 12:55:26 PM

4 Replies
391 Views

(page loaded in 0.073 seconds)

Similiar Articles:
















7/25/2012 3:35:05 PM


Reply: