Endless Loop

krazyness

New Member
Joined
Jan 31, 2017
Messages
26
Office Version
  1. 365
Platform
  1. Windows
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.

Code:
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
 
Last edited by a moderator:

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
You might consider the highlighted changes...

Code:
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
 
Upvote 0
That seems to have worked. Thanks!

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

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top