Loop through arrays with multiple columns and rows - excel

Question

I've done a lot of searching to try and optimize this code. I've reduced the run time down significantly, but I can't seem to find anything else (note: I've done all the xlcalculationmanual and screenupdating = false jazz)
Here is the basic structure of my current loop. The matrix is currently 5 rows down with data to loop through and 9 across.
Application.Calculation = xlCalculationManual
i = 0
Do While wsc1.Cells(10, i + 65) <> "things" And wsc1.Cells(10, i + 65) <> "thing2" And wsc1.Cells(10, i + 65) <> ""
j = 0
Do While wsc1.Cells(j + 11, 64) <> ""
wsc.Cells(109, 3) = wsc1.Cells(j + 11, 64) 'rows
wsc.Cells(109, 6) = wsc1.Cells(10, i + 65) 'columns
Application.Calculation = xlCalculationAutomatic
Application.Calculation = xlCalculationManual
wsc1.Cells(j + 11, i + 65) = wsc.Range("O6") 'Print
j = j + 1
Loop
i = i + 1
Loop
I assume my next best option is storing the column/row vector as a variant and looping through that?
Thanks

Answer 1

Can you also add these lines?
Application.EnableEvents = False
Application.ScreenUpdating = False ' it seems that you already have this one?

Answer 2

Give this a try. However, having to wait for the sheet calculation is a pretty hard slowdown, there's really not much that can be done beyond this to improve performance if we can't put the calculations in the code.
Sub tgr()
Dim wsc1 As Worksheet
Dim CValues As Variant
Dim FValues As Variant
Dim Results() As Variant
Dim i As Long, j As Long
Dim xlCalc As XlCalculation
With Application
xlCalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
On Error GoTo CleanExit
Set wsc1 = ActiveWorkbook.ActiveSheet
With wsc1.Range("BL11", wsc1.Cells(wsc1.Rows.Count, "BL").End(xlUp))
If .Row < 11 Then Exit Sub 'No data
If .Cells.Count = 1 Then
ReDim CValues(1 To 1, 1 To 1)
CValues(1, 1) = .Value
Else
CValues = .Value
End If
End With
With wsc1.Range("BM10", wsc1.Cells(10, wsc1.Columns.Count).End(xlToLeft))
If .Column < Columns("BM").Column Then Exit Sub 'No data
If .Cells.Count = 1 Then
ReDim FValues(1 To 1, 1 To 1)
FValues(1, 1) = .Value
Else
FValues = .Value
End If
End With
ReDim Results(1 To UBound(CValues, 1), 1 To UBound(FValues, 2))
For i = LBound(CValues, 1) To UBound(CValues, 1)
For j = LBound(FValues, 2) To UBound(FValues, 2)
wsc1.Range("C109").Value = CValues(i, 1)
wsc1.Range("F109").Value = FValues(1, j)
wsc1.Calculate
Results(i, j) = wsc1.Range("O6").Value
Next j
Next i
wsc1.Range("BM11").Resize(UBound(Results, 1), UBound(Results, 2)).Value = Results
CleanExit:
With Application
.Calculation = xlCalc
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub