Endless Loop

[krazyness]

I had an expert write a script for me, and it worked once it was given to me... on my test data.

Now it just runs an endless loop and never stops starting over. I haven't given the developer but a few hours to respond, but I'm at a loss. Any help would be appreciative.

I did not know how to copy the code correctly apparently... as copy/paste took formatting out.

Sub CleanData()
    Dim SearchRange As Range, CopyRow As Integer
    'Clear sheet page breaks
    ActiveWindow.View = xlPageBreakPreview
    ActiveSheet.ResetAllPageBreaks
    ActiveSheet.VPageBreaks(1).DragOff xlToRight, 1
    'Define header row to copy. This must be updated if header row changes in the report.
    CopyRow = 10
    'Identify starting point of data
    Set SearchRange = ActiveSheet.Range("A:A").Find("------------")
    'Start a loop to find all cells in column A containing "------------"
    Do
        'Some of the headers are already present. Paste if it isn't already there
        If Not SearchRange.Offset(-2, 0) = "PT #" Then
            ActiveSheet.Rows(CopyRow).Copy
            ActiveSheet.Range(SearchRange.Address).Offset(-1, 0).PasteSpecial xlPasteAll
            ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveSheet.Range(SearchRange.Address).Offset(-1, 0)
        Else
            ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveSheet.Range(SearchRange.Address).Offset(-2, 0)
        End If
        'Set the cell to accept a formula. Insert formula as defined by requirements
        ActiveSheet.Range(SearchRange.Address).Offset(4, 5).NumberFormat = "General"
        ActiveSheet.Range(SearchRange.Address).Offset(4, 5).FormulaR1C1 = "=sum(r[-3]c[0] * 15%)"
        ActiveSheet.Range(SearchRange.Address).Offset(4, 5).NumberFormat = "#.##"
        'Find next row to run loop on
        Set SearchRange = ActiveSheet.Range("A:A").FindNext(SearchRange)
    Loop While SearchRange.Address <> Range("A12").Address And (Not SearchRange Is Nothing)
End Sub

 

[tonyyy]

You might consider the highlighted changes...

Sub CleanData()
    Dim SearchRange As Range, CopyRow As Integer[COLOR=#ff0000], firstAddress As String[/COLOR]
    'Clear sheet page breaks
    ActiveWindow.View = xlPageBreakPreview
    ActiveSheet.ResetAllPageBreaks
    ActiveSheet.VPageBreaks(1).DragOff xlToRight, 1
    'Define header row to copy. This must be updated if header row changes in the report.
    CopyRow = 10
    'Identify starting point of data
    Set SearchRange = ActiveSheet.Range("A:A").Find("------------")
    [COLOR=#ff0000]firstAddress = SearchRange.Address[/COLOR]
    'Start a loop to find all cells in column A containing "------------"
    Do
        'Some of the headers are already present. Paste if it isn't already there
        If Not SearchRange.Offset(-2, 0) = "PT #" Then
            ActiveSheet.Rows(CopyRow).Copy
            ActiveSheet.Range(SearchRange.Address).Offset(-1, 0).PasteSpecial xlPasteAll
            ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveSheet.Range(SearchRange.Address).Offset(-1, 0)
        Else
            ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveSheet.Range(SearchRange.Address).Offset(-2, 0)
        End If
        'Set the cell to accept a formula. Insert formula as defined by requirements
        ActiveSheet.Range(SearchRange.Address).Offset(4, 5).NumberFormat = "General"
        ActiveSheet.Range(SearchRange.Address).Offset(4, 5).FormulaR1C1 = "=sum(r[-3]c[0] * 15%)"
        ActiveSheet.Range(SearchRange.Address).Offset(4, 5).NumberFormat = "#.##"
        'Find next row to run loop on
        Set SearchRange = ActiveSheet.Range("A:A").FindNext(SearchRange)
    [COLOR=#ff0000]Loop While SearchRange.Address <> firstAddress And (Not SearchRange Is Nothing)[/COLOR]
End Sub

Cheers,

tonyyy

 

[krazyness]

That seems to have worked. Thanks!

The dev did reach out right after you posted this. all for timing.

 

[tonyyy]

You're very welcome...