Macro for merging rows
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. |
Macro for merging rows
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 |
Macro for merging rows
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" wrote in message ... 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 |
Macro for merging rows
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" wrote in message ... |
All times are GMT +1. The time now is 08:00 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com