VBA code not working for a large number of iterations

Question

For some reason this macro freezes EXCEL when I set the for home = X to XX loop to more than 10 iterations.

This code downloads a webpage into excel, extracts cells that contain either 'overall' or 'carried' and copy them into another sheet in the same workbook.

Thank you

Sub Macro1()
'
' Macro1 Macro
'

'

Dim home                As Integer

Dim Calc_sheet          As Worksheet

Dim score_count         As Integer
Dim inspection_count    As Integer

Dim output_rows         As Integer
Dim output_columns      As Integer
Dim date_columns        As Integer


'Counting variables
score_count = 3
inspection_count = 8

'Output rows and columns starting values
output_rows = 3
output_columns = 3
date_columns = 8

For home = 20 To 23

With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;http://www.XXXXXXXX.org.uk/directory/" & Sheets("Output").Cells(home, 1), Destination:=Range("$A$1") _
    )
    '.CommandType = 0
    .Name = "Homes"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With



    For x = 20 To 250
        Select Case Left(Cells(x, 1), 7)

        'Is it a score?
        Case Is = "Overall"
            Cells(x, 1).Copy
            Sheets("Output").Select
            Cells(output_rows, output_columns).Select
            ActiveSheet.Paste
            output_columns = output_columns + 1

        'Is it a date?
        Case Is = "Carried"
            Cells(x, 1).Copy
            Sheets("Output").Select
            Cells(output_rows, date_columns).Select
            ActiveSheet.Paste
            date_columns = date_columns + 1

        Case Else

        End Select

        Sheets("Calc_sheet").Activate
        Cells(x, 1).Activate

    Next x
'Clean sheet
ActiveSheet.Cells.Delete

'Go back to top
Range("A1").Select

'Reset column count
output_columns = 3
date_columns = 8

output_rows = output_rows + 1
Next home


End Sub

By crashes excel, what do you mean? Are you getting an error message of some sort? — Ben Black, Jan 16 '14 at 15:10
You may consider using xmlhttp instead of webquery. Refer this [link](http://stackoverflow.com/questions/21039677/import-data-in-excel-from-a-table-created-by-a-script-in-a-webpage/21040225#21040225) and [link2](http://stackoverflow.com/questions/20832017/import-tables-from-a-webpage-to-excel/20832886#20832886) — Santosh, Jan 16 '14 at 15:12
Santosh, any particular reason why you believe this would help? — Max F, Jan 16 '14 at 15:16
Only instances where I've had Excel really freeze on me in cases like this were when the server was taking a long time to respond, are you sure it's not related to the values of `Sheets("Output").Cells(home, 1)` being invalid and throwing the macro off? — Bernard Saucier, Jan 16 '14 at 15:23
@Santosh : Problem is that the downloading bit works, i can download 100 pages no problem. But if i combine it with the data cleaning code (the code that starts at for x 20 to 250, where I loop through cells to find keywords) then it breaks. So its not a download problem — Max F, Jan 16 '14 at 15:25
Might want to double-check the values in the cells that you're building the url query with then? — Ben Black, Jan 16 '14 at 15:27
@BernardSaucier : The value in Sheets("Output").Cells(home,1) are fine as the downloading code works when I comment out the bit of code that captures the information I need and copies it into another worksheet — Max F, Jan 16 '14 at 15:28
To give a further example, when I see that the code breaks between the 20th and 25th value of Sheets("Output").Cells(home,1) i run the vba code for each value separately and it works perfectly. It's when for loop iterations are above 10 or something that the thing crashes somehow — Max F, Jan 16 '14 at 15:30
Your probably experiencing issues with the clipboard running out of memory from coping to much. Try replacing the copy select activate portion of your code with: `Sheets("Output").Cells(output_rows, Output_columns).Value = Cells(x, 1) output_columns = output_columns + 1` along with that is would defiantly be smart to get rid of all of your Selects, and Activates, and use Absolute referencing. — user2140261, Jan 16 '14 at 15:42

Bernard Saucier · Answer 1 · 2014-01-16T16:13:26.393

I updated the code, try it again!

Try replacing your inner-loop with this one :

Dim wsC As Worksheet
Dim wsO As Worksheet

Set wsC = Worksheets("Calc_sheet")
Set wsO = Worksheets("Output")

For x = 20 To 250

    yourContent = wsC.Cells(x, 1)
    yourCase = Left(yourContent, 7)

    Select Case yourCase

    'Is it a score?
    Case Is = "Overall"
        wsO.Cells(output_rows, output_columns) = yourContent
        output_columns = output_columns + 1

    'Is it a date?
    Case Is = "Carried"
        wsO.Cells(output_rows, date_columns) = yourContent
        date_columns = date_columns + 1

    Case Else

    End Select

Next x

Bernard this is great as it works for 20+, but freezes for 50+ ... Any other suggestions? Merci milles fois! — Max F, Jan 16 '14 at 16:07

VBA code not working for a large number of iterations

1 Answers1