Excel VBA crashing due to size - vba

Question

I made a script in VBA that should read a very long Pivot Table with over 190,000 entries in the "Data" sheet, and according with the value in the column "J", it should write the info from that row in a sheet called "Temp".
When the value from column "A" changes, it should read from sheet "Regioner" a list of over 600 entries and check if each value is presented in the previous arrays of values.
The code I wrote works, but it takes forever to write down the expected 220,000 entries in the "Temp" sheet. In my laptop, i5 6th generation with 8Gb RAM, it simply crashes.
The current code is as per below.
Many thanks to all!
Public Sub FindWithoutOrder()
Dim DataRowCounter As Long
Dim TempRowCounter As Long
Dim RegiRowCounter As Long
Dim DataOldCounter As Long
Dim DataNewCounter As Long
Dim loopCounter As Long
Dim DataOldProd As Range
Dim DataNewProd As Range
Dim DataPurchase As Range
Dim RegiButikk As Range
Dim ButikkFlag As Boolean
'Code optimization to run faster.
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Initialize variables.
'----------------------------------------------------------------------------------------------------------
DataRowCounter = 11
TempRowCounter = 1
DataOldCounter = 11
DataNewCounter = 11
Set DataOldProd = ActiveWorkbook.Sheets("Data").Range("A" & DataRowCounter)
Set DataNewProd = ActiveWorkbook.Sheets("Data").Range("A" & DataRowCounter)
Set DataPurchase = ActiveWorkbook.Sheets("Data").Range("J" & DataRowCounter)
'Start of loop that verifies all values inside "Data" sheet.
'----------------------------------------------------------------------------------------------------------
Do Until (IsEmpty(DataOldProd) And IsEmpty(DataNewProd))
'Verify if the product of new line is still the same or different.
'------------------------------------------------------------------------------------------------------
If DataNewProd.Value = DataOldProd.Value Then
DataNewCounter = DataNewCounter + 1
Else
'Initialize variables from "Regioner" sheet.
'------------------------------------------------------------------------------------------
ButikkFlag = False
RegiRowCounter = 11
Set RegiButikk = ActiveWorkbook.Sheets("Regioner").Range("C" & RegiRowCounter)
'Verify list of supermarkets and match them with purchases list.
'--------------------------------------------------------------------------------------------------
Do Until IsEmpty(RegiButikk)
'Check all supermarkets in the product range.
'----------------------------------------------------------------------------------------------
For loopCounter = DataOldCounter To DataNewCounter - 1
'Compare both entries and register them if it doesn't exist in the product list.
'------------------------------------------------------------------------------------------
If RegiButikk.Value = ActiveWorkbook.Sheets("Data").Range("D" & loopCounter).Value Then
ButikkFlag = True
RegiRowCounter = RegiRowCounter + 1
Set RegiButikk = ActiveWorkbook.Sheets("Regioner").Range("C" & RegiRowCounter)
Exit For
Else
ButikkFlag = False
End If
Next loopCounter
'Add to list supermarkets not present in the purchases list.
'------------------------------------------------------------------------------------------
If ButikkFlag = False Then
ActiveWorkbook.Sheets("Temp").Range("B" & TempRowCounter & ":D" & TempRowCounter).Value = ActiveWorkbook.Sheets("Regioner").Range("A" & RegiRowCounter & ":C" & RegiRowCounter).Value
ActiveWorkbook.Sheets("Temp").Range("A" & TempRowCounter).Value = ActiveWorkbook.Sheets("Data").Range("A" & DataRowCounter - 1).Value
TempRowCounter = TempRowCounter + 1
RegiRowCounter = RegiRowCounter + 1
Set RegiButikk = ActiveWorkbook.Sheets("Regioner").Range("C" & RegiRowCounter)
End If
Loop
'Reset the product range.
'--------------------------------------------------------------------------------------------------
DataOldCounter = DataNewCounter
DataNewCounter = DataNewCounter + 1
End If
'Validate if item was purchased in the defined period and copy it.
'------------------------------------------------------------------------------------------------------
If DataPurchase.Value = 0 Then
ActiveWorkbook.Sheets("Temp").Range("A" & TempRowCounter & ":D" & TempRowCounter).Value = ActiveWorkbook.Sheets("Data").Range("A" & DataRowCounter & ":D" & DataRowCounter).Value
TempRowCounter = TempRowCounter + 1
End If
'Update row counter and values for previous and new product readed.
'------------------------------------------------------------------------------------------------------
Set DataOldProd = ActiveWorkbook.Sheets("Data").Range("A" & DataRowCounter)
DataRowCounter = DataRowCounter + 1
Set DataNewProd = ActiveWorkbook.Sheets("Data").Range("A" & DataRowCounter)
Set DataPurchase = ActiveWorkbook.Sheets("Data").Range("J" & DataRowCounter)
Loop
'Code optimization to run faster.
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Answer 1

Instead of having this code scattered all over the place:
'Code optimization to run faster.
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Use this procedure:
Public Sub ToggleWaitMode(ByVal wait As Boolean)
Application.Cursor = IIf(wait, XlMousePointer.xlWait, XlMousePointer.xlDefault)
Application.StatusBar = IIf(wait, "Working...", False)
Application.Calculation = IIf(wait, XlCalculation.xlCalculationManual, XlCalculation.xlCalculationAutomatic)
Application.ScreenUpdating = Not wait
Application.EnableEvents = Not wait
End Sub
Like this:
Public Sub DoSomething()
ToggleWaitMode True
On Error GoTo CleanFail
'do stuff
CleanExit:
ToggleWaitMode False
Exit Sub
CleanFail:
'handle errors
Resume CleanExit
End Sub
Disabling automatic calculation and worksheet events should already help quite a lot... but it's by no means "optimizing" anything. It simply makes Excel work [much] less, whenever a cell is modified.
If your code works but is just slow, take it to Code Review Stack Exchange and present it to the VBA reviewers: they'll go out of their ways to help you actually optimize your code. I know, I'm one of them =)