Loop macro - how do I get the loop to stop?!

[dcwinter]

Hello,

Can anyone see anything wrong with this?:


Sub Reportsloop2()
Sheets("Reference Sheet").Select
Cells(1, 16).Select
Do Until ActiveCell.Offset(1, 0).Value = ""
Run ("Loop2")
Loop
End Sub

It's driving me mad!

Also, how do I add code into a box when posting a message?

Cheers

Danny

 

[Richard Schollar]

Hi Danny

Use "["Code"]" tags (and closing "["/code"]" tag) around your code.

What is Loop2?

 

[dcwinter]

Hello Richard,

Loop2 is a macro which sorts out the data range and pastes it into a new workbook.

The macros are working - but when it gets to a blank cell it tries to continue. It doesn't get very far before an error comes up which is good because it'd be almost never ending if not!

Cheers

Danny

 

[Richard Schollar]

Whatever is happening is the result of code within your loop2 macro - if you would post that then we can analyse why it's happening.

 

[dcwinter]

OK, but bare with it because it's a bit of a work in progress right now!

Private Sub Loop2()
Sheets("Reference Sheet").Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Copy
Workbooks("Foodservice Sales Dashboard.xls").Activate
ActiveWorkbook.Sheets("Data Sheet - Product List").Activate
ActiveSheet.Unprotect
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues
Workbooks("Foodservice Sales Dashboard.xls").Activate
ActiveWorkbook.Sheets("Data Sheet - Product List").Activate
Rows("5:250").Select
Selection.EntireRow.Hidden = False
Dim myRng As Range
Set myRng = Range("U113", Range("U289").End(xlUp))
Application.ScreenUpdating = False
For Each c In myRng
If c.Value = 0 Then c.EntireRow.Hidden = True
If c.Value <> 0 Then c.EntireRow.Hidden = False
Next c
Workbooks("Dashboard Monthly Reports - Scotland.xls").Activate
Sheets.Add
Workbooks("Foodservice Sales Dashboard.xls").Activate
ActiveWorkbook.Sheets("Data Sheet - Product List").Activate
Cells.Select
Selection.Copy
Range("B1").Select
Workbooks("Dashboard Monthly Reports - Scotland.xls").Activate
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        For i = 1 To [A65536].End(xlUp).Row
        If Range("U1") = 0 Then
        Rows("113:250").Select
        Selection.Delete Shift:=xlUp
        End If
If Rows(i).Hidden = True Then
Rows(i).EntireRow.Delete
i = i - 1
End If
Next i
Range("B2").Select
Cells.Replace What:="               ", Replacement:=""
Range("C2:E2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=CLEAN(RC[-1])"
    Range("C3").Select
        Range("F2").Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-3],31)"
    Range("F2").Select
    Cells.Replace What:="/", Replacement:=""
    ActiveSheet.Name = Range("F2").Value
Workbooks("Foodservice Sales Dashboard.xls").Activate
        Application.ScreenUpdating = True
End Sub

Cheers

Danny

 

[Richard Schollar]

The last line of your macro is this:

Workbooks("Foodservice Sales Dashboard.xls").Activate

This is (obviously) activating "Foodservice Sales Dashboard.xls" - the Activecell is somewhere in this workbook on some sheet or other. Because of all your activating and selecting in all probability the Activecell probably isn't where you think it is.

In your original code, try amending the code as follows and run it (you can always esacpe from the loop with Ctrl+Break if required):

Sub Reportsloop2()
Sheets("Reference Sheet").Select
Cells(1, 16).Select
Do Until ActiveCell.Offset(1, 0).Value = ""
Run ("Loop2")
Msgbox "Activecell on sheet " & Activecell.Parent.Name & chr(10) & "Cell address " & Activecell.Address
Loop
End Sub

This will let you see where the Activecell is (which i expect to either be different from what you think it is, or it won't change from one iteration to the next).

 

[dcwinter]

Hi Richard,

Thanks for that!

It's worked a treat!!!

Really appreciate your help!!

Danny