PDA

View Full Version : Loop as long as row above has data



dkassin
02-29-2012, 09:37 AM
I have a macro that inserts a row and then inserts data for six columns.

I need to get the macro to insert data for all rows that have data in the columns.

I figured that the macro would look something like this

'Sub

'Insert Row

'Loop as long as there is data in the row above

'Macro runs

"end Loop

End Sub

Any ideas how to do this

mdmackillop
02-29-2012, 10:54 AM
Where does the data come from? Can you post a sample workbook?

dkassin
02-29-2012, 12:56 PM
Here is The code. Right now the code is not looping correctly

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+x
'
Sheets("2").Select
Application.Run "BLPLinkReset"
Rows("4:4").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Do
ActiveCell.Offset(-1, 0).Select
ActiveCell.FormulaR1C1 = "=SUM(R4C:R[475]C)"
ActiveCell.Offset(0, 2).Select
ActiveCell.FormulaR1C1 = "=SUM(R[1]C:R[475]C)"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=SUM(R4C:R[475]C)"
ActiveCell.Offset(0, 2).Select
ActiveCell.FormulaR1C1 = "=SUM(R[1]C:R[475]C)"
Sheets("1").Select
Application.Run "BLPLinkReset"
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 35
ActiveWindow.ScrollColumn = 39
ActiveWindow.ScrollColumn = 43
ActiveWindow.ScrollColumn = 47
ActiveWindow.ScrollColumn = 50
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 55
ActiveWindow.ScrollColumn = 57
ActiveWindow.ScrollColumn = 58
ActiveWindow.ScrollColumn = 60
ActiveWindow.ScrollColumn = 61
ActiveWindow.ScrollColumn = 62
ActiveWindow.ScrollColumn = 63
ActiveWindow.ScrollColumn = 64
Range("BX1").Offset(1, 0).Select
Selection.cOPY
Sheets("2").Select
Application.Run "BLPLinkReset"
Range("A1").Offset(3, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(-1, 1).Select
Application.CutCopyMode = False
Selection.cOPY
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=(R[-1]C[-1]-RC[-1])*RC[-2]"
Sheets("1").Select
Application.Run "BLPLinkReset"
Range("BY1").Offset(1, 0).Select
Selection.cOPY
Sheets("2").Select
Application.Run "BLPLinkReset"
Range("D1").Offset(3, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(-1, 1).Select
Application.CutCopyMode = False
Selection.cOPY
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=(RC[-1]-R[-1]C[-1])*RC[-2]"
ActiveCell.Offset(0, 1).Select
Loop Until (IsEmpty(ActiveCell.Offset(-1, 0))) = False
End Sub

mdmackillop
02-29-2012, 01:20 PM
And this is?
Application.Run "BLPLinkReset"
A workbook with data lets us test your code.

dkassin
02-29-2012, 01:37 PM
Its an unnecessary link, but I figured it out. Thanks

wakdafak
03-01-2012, 12:00 AM
hye dkassin
maybe you can try this
you problem is kinda same as me
i manage to solve it :beerchug:


sub compile()
Application.DisplayAlerts = False
Dim sheetnum As Integer

Sheets("2").Select
With ActiveSheet
Lastrow_Track = .Cells(.Rows.Count, "O").End(xlUp).Row
End With
Sheets(sheetnum).Select
With ActiveSheet
Lastrow_CB_Err = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

row_track = Lastrow_Track + 1
For Row = 2 To Lastrow_CB_Err
Sheets("2").Cells(row_track, 1).Value = Sheets("1").Cells(Row, 1).Value
row_track = row_track + 1
Next

end sub