On Sep 5, 2:14*pm, rockfal...@yahoo.com wrote:
> I have a worksheet with over 2000 rows and 6 columns and I would like
> to
> consolidate some multi-row entries into a single line.
>
> The format for many (but not all) of the entries is this:
>
> text1 *| *text2 *| *text3 *| *titleA * *| *titleB * * * *| *titleC
> * * * * *| * * * * * | * * * * * *| *123456 | somestuff *|
> calculatedvalueX
>
> Where the first three cells of the second line are blank.
>
> I would like to perform the following action:
> * * 1) Cut the values in the last three cells of the second line.
> * * 2) Paste those values into the equivalent cells of the first line..
> * * 3) Delete the second line (now that it does not have any data).
>
> Unfortunately, some entries have this two-line format, while other
> entries may have the first line with all six columns populated but
> then "n" number of rows with only cell columns D, E, and F populated
> (and those first three columns each having merged cells of n-rows).
> The entries with "n" number of rows are randomly distributed in the
> 2000+ row spreadsheet, so I can't know as I'm scanning through the
> spreadsheet when I'll encounter a two-line or an n-line entry. For
> that
> reason, I thought a macro I could call while manually scrolling
> through
> the rows would work best (later, I'll figure out how to deal with the
> n-line
> entries, perhaps by putting their values in successive columns in the
> same row).
>
> So, how can such a macro be constructed and run so that it does not
> have absolute references to cells and rows but can work equally as
> well
> at row #4 as at row # 444?
>
> (If there's VB code that can do this automagically without the manual
> macro application, all the better.)
>
> advTHANKSance.
This will move data in columns D, E, F into A, B, C respectively for
the previous row, if the cell in column A is blank.
A B C D E F
1 2 3 4 5 6
7 8 9
Will become
A B C D E F
7 8 9 4 5 6
Is that what you were after?
Regards,
Steven
Sub CombineRows()
Dim WS As Worksheet
Dim Rng1 As Range
Dim MyCell As Range
Set WS = ActiveSheet
Set Rng1 = WS.Range("A1:A2000")
For Each MyCell In Rng1
If MyCell.Value = "" Then
MyCell.Offset(-1, 0).Value = MyCell.Offset(0, 3).Value
MyCell.Offset(-1, 1).Value = MyCell.Offset(0, 4).Value
MyCell.Offset(-1, 2).Value = MyCell.Offset(0, 5).Value
Rows((MyCell.Row) & ":" & (MyCell.Row)).Delete
End If
Next
End Sub
|