Simplify this into a loop

[Guest]

I have a formula that I have to copy 150 times. I know that there is a
simple way to convert it to a loop macro but I don't know how to do it. Can
someone help me on this one??? this is the macro that I create and I have to
do it from cell 16 to cell 166 so it will go 150 until it find a stop cell.
Thanks.

This is the macro:

Sub SinglMixInfo_Button5_Click()

Rows("13:150").Select
Selection.Delete Shift:=xlUp
Sheets("form").Select
Range("B13:y17").Select
Selection.Copy
Sheets("Single & Mix Info").Select
Range("B13").Select
ActiveSheet.Paste


Rows("15:15").Select
Selection.Copy
Rows("16:16").Select
Selection.Insert Shift:=xlDown
If Range("x16") = "stop" Then
Range("16:16").Select
Selection.Delete
Exit Sub
Else
Rows("15:15").Select
Selection.Copy
Rows("17:17").Select
Selection.Insert Shift:=xlDown
If Range("x17") = "stop" Then
Range("17:17").Select
Selection.Delete
Exit Sub
Else
Rows("15:15").Select
Selection.Copy
Rows("18:18").Select
Selection.Insert Shift:=xlDown
End If
End If
End Sub

 

[Guest]

Sub SinglMixInfo_Button5_Click()

Rows("13:150").Select
Selection.Delete Shift:=xlUp
Sheets("Single & Mix Info").Range("B13") = _
Sheets("form").Range("B13:y17")


Sheets("Single & Mix Info").Activate
Lastrow = Cells(Rows.Count, 24).End(xlUp).Row
Set StopRange = Range("X16:X" & Lastrow)
Set c = StopRange.Find("stop", LookIn:=xlValues)
If Not c Is Nothing Then
Set PasteRange = Range("16:" & (c.Row - 1))
Sheets("Single & Mix Info").Rows("15:15").Copy _
Destination:=PasteRange

End If

End Sub

 

[Guest]

Sub SinglMixInfo_Button5_Click()

Rows("13:150").Select
Selection.Delete Shift:=xlUp
Sheets("Dividend_Tracking").Select
Range("B13:y17").Select
Selection.Copy
Sheets("FX Settlement Instructions.xls").Select
Range("B13").Select
ActiveSheet.Paste

Rows("15:15").Select
Selection.Copy
Range("A16").Select
Do
z = ActiveCell.Row
Selection.EntireRow.Insert Shift:=xlDown
If ActiveCell.Offset(0, 24) = "stop" Then
ActiveCell.EntireRow.Delete
Exit Sub
Else
Rows("15:15").Select
Selection.Copy
End If
Loop Until z = 150
End Sub

 

[Guest]

Don't know why Joel but the second part is not working or is not doing
anything... can you help me? Please?

 

[Guest]

Joel I don't really know why but the second part is not working. :-(

 

[Guest]

Victor,

I'm not exactly sure how your code will encounter a "stop" cell because it
seems to copy and insert row 15 to the current row unless column X says
"stop". If there ever is a "stop" on the next row, it will just keep getting
pushed down. Unless, there's a formula on column X that evaluates to "stop"
based on the current row. But anyway, give this a try.


Sub SinglMixInfo_Button5_Click()

Rows("13:150").Delete SHift:=xlUp
Sheets("form").Range("B13:Y17").Copy Range("B13")

Dim lRow As Long

For lRow = 16 To 150
If UCase(Range("X" & lRow).Text) = "STOP" Then
Rows(lRow & ":" & lRow).Delete
Exit For
Else
Rows("15:15").Copy
Rows(lRow & ":" & lRow).Insert SHift:=xlDown
End If
Next lRow

End Sub

 

[Guest]

I don't know how your cells are organized. Deleting row 13:150 removes a lot
of data and could remove the stop. The stop needs to be after row 150
otherwise it gets removed.

 

[Guest]

Hi Vergel and all those who help me with this codes. All codes were goods
ones but the one that I use was Vergel with some modification because the
"stop" was in the last copy line so I have to add a -1 to make it work. And
some more. Here is the code that Vergel send me with the modification that I
did. Thanks again to all those that help me... ;-)

Sub SinglMixInfo_Button5_Click()

Rows("13:150").Select
Selection.Delete SHift:=xlUp
Sheets("Compare").Select
Range("aj13:bg17").Select
Selection.Copy
Sheets("Single & Mix Info").Select
Range("B13").Select
ActiveSheet.Paste

Dim lRow As Long

For lRow = 16 To 150
If Range("X" & lRow - 1).Text = "stop" Then
Rows(lRow - 1 & ":" & lRow - 1).Delete
Sheets("Compare").Select
Range("A1").Select
Sheets("Single & Mix Info").Select
Range("B2:C2").Select
Application.CutCopyMode = False
Exit For
Else
Rows("15:15").Copy
Rows(lRow & ":" & lRow).Insert SHift:=xlDown
End If
Next lRow

End Sub