Simplify this into a loop

  • Thread starter Thread starter Guest
  • Start date Start date
G

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
 
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
 
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
 
Don't know why Joel but the second part is not working or is not doing
anything... can you help me? Please?
 
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
 
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.
 
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
 
Back
Top