VBA code not working for a large number of iterations - vba

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

Answer 1

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