Excel crashes when Macro is run

[WhiteD13]

Hi guys,

I have a VBA script that takes data from two workbooks, modifies them and puts them into a third workbook. However at some point in the second loop of the script the process crashes and Excel freezes up. Are thee any ways to speed the script up to make it a little easier on Excel? The initial workbooks are pretty large often around 60K rows. I'm fairly new to VBA so apologies if I've made some massive error in the coding, just worked it out from what I would do manually to the steps.

Any advice would be greatly appreciated. Below is the code.

Public Sub CommandButton1_Click()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Dim RowNumber As Long
Dim BORowNumber As Long
Dim INCRowNumber As Long
Dim BODoc As Variant, BOwb As Workbook
Dim INCDoc As Variant, INCwb As Workbook
Dim PDwb As String

RowNumber = CLng(1)
BORowNumber = CLng(4)
INCRowNumber = CLng(1)
PDwb = ThisWorkbook.Name

MsgBox ("Enter an INC Docment")

INCDoc = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select File To Be Opened")
If INCDoc = False Then Exit Sub
Set INCwb = Workbooks.Open(INCDoc)

INCwb.Sheets("Stock").Select

Do Until IsEmpty(ActiveCell)

RowNumber = RowNumber + 1
INCRowNumber = INCRowNumber + 1

Workbooks(PDwb).Sheets("pivotdata").Range("B" & RowNumber).Value = "INC"
Workbooks(PDwb).Sheets("pivotdata").Range("K" & RowNumber & ":P" & RowNumber).Value = "0"
Workbooks(PDwb).Sheets("pivotdata").Range("Q" & RowNumber).Value = INCwb.Sheets("Stock").Range("K" & INCRowNumber).Value
Workbooks(PDwb).Sheets("pivotdata").Range("R" & RowNumber).Value = INCwb.Sheets("Stock").Range("M" & INCRowNumber).Value
Workbooks(PDwb).Sheets("pivotdata").Range("S" & RowNumber).Value = Workbooks(PDwb).Sheets("pivotdata").Range("Q" & RowNumber).Value + _
Workbooks(PDwb).Sheets("pivotdata").Range("R" & RowNumber).Value
Workbooks(PDwb).Sheets("pivotdata").Range("T" & RowNumber).Value = INCwb.Sheets("Stock").Range("L" & INCRowNumber).Value
Workbooks(PDwb).Sheets("pivotdata").Range("U" & RowNumber).Value = INCwb.Sheets("Stock").Range("N" & INCRowNumber).Value
Workbooks(PDwb).Sheets("pivotdata").Range("V" & RowNumber).Value = Workbooks(PDwb).Sheets("pivotdata").Range("T" & RowNumber).Value + _
Workbooks(PDwb).Sheets("pivotdata").Range("U" & RowNumber).Value
Workbooks(PDwb).Sheets("pivotdata").Range("J" & RowNumber).Value = Abs(Left(OnlyNums(INCwb.Sheets("Stock").Range("H" & INCRowNumber).Value), 8))
Workbooks(PDwb).Sheets("pivotdata").Range("C" & RowNumber).Value = Abs(Left(OnlyNums(INCwb.Sheets("Stock").Range("B" & INCRowNumber).Value), 8))
Workbooks(PDwb).Sheets("pivotdata").Range("H" & RowNumber).Value = INCwb.Sheets("Stock").Range("D" & INCRowNumber).Value
If INCwb.Sheets("Stock").Range("J" & INCRowNumber).Value = "ON_HAND" Or INCwb.Sheets("Stock").Range("J" & INCRowNumber).Value = "ON HAND" Then
Workbooks(PDwb).Sheets("pivotdata").Range("E" & RowNumber).Value = "ON-HAND"
ElseIf INCwb.Sheets("Stock").Range("J" & INCRowNumber).Value = "ON_HAND" Then
Workbooks(PDwb).Sheets("pivotdata").Range("E" & RowNumber).Value = "IN-TRANSIT"
Else
Workbooks(PDwb).Sheets("pivotdata").Range("E" & RowNumber).Value = Cell
End If

If (IsError(Application.VLookup(INCwb.Sheets("Stock").Range("C" & INCRowNumber).Value, _
Workbooks(PDwb).Sheets("Ctrl").Range("$B$2:$C$13"), 2, False))) Then

Workbooks(PDwb).Sheets("pivotdata").Range("D" & RowNumber).Value = "*chk*"

Else

Workbooks(PDwb).Sheets("pivotdata").Range("D" & RowNumber).Value = _
Application.VLookup(INCwb.Sheets("Stock").Range("C" & INCRowNumber).Value, _
Workbooks(PDwb).Sheets("Ctrl").Range("$B$2:$C$13"), 2, False)

End If

If (IsError(Application.VLookup(INCwb.Sheets("Stock").Range("D" & INCRowNumber).Value, _
Workbooks(PDwb).Sheets("Ctrl").Range("$H$1:$M$200"), 3, False))) Then

Workbooks(PDwb).Sheets("pivotdata").Range("F" & RowNumber).Value = "*chk*"

Else

Workbooks(PDwb).Sheets("pivotdata").Range("F" & RowNumber).Value = _
Application.VLookup(INCwb.Sheets("Stock").Range("D" & INCRowNumber).Value, _
Workbooks(PDwb).Sheets("Ctrl").Range("$H$1:$M$200"), 3, False)

End If

If (IsError(Application.VLookup(INCwb.Sheets("Stock").Range("D" & INCRowNumber).Value, _
Workbooks(PDwb).Sheets("Ctrl").Range("$H$1:$M$200"), 4, False))) Then

Workbooks(PDwb).Sheets("pivotdata").Range("G" & RowNumber).Value = "*chk*"

Else

Workbooks(PDwb).Sheets("pivotdata").Range("G" & RowNumber).Value = _
Application.VLookup(INCwb.Sheets("Stock").Range("D" & INCRowNumber).Value, _
Workbooks(PDwb).Sheets("Ctrl").Range("$H$1:$M$200"), 4, False)

End If

If (IsError(Application.VLookup(INCwb.Sheets("Stock").Range("D" & INCRowNumber).Value, _
Workbooks(PDwb).Sheets("Ctrl").Range("$H$1:$M$200"), 6, False))) Then

Workbooks(PDwb).Sheets("pivotdata").Range("I" & RowNumber).Value = "*chk*"

Else

Workbooks(PDwb).Sheets("pivotdata").Range("I" & RowNumber).Value = _
Application.VLookup(INCwb.Sheets("Stock").Range("D" & INCRowNumber).Value, _
Workbooks(PDwb).Sheets("Ctrl").Range("$H$1:$M$200"), 6, False)

End If

Workbooks(PDwb).Sheets("pivotdata").Range("A" & RowNumber).Value = Workbooks(PDwb).Sheets("pivotdata").Range("D" & RowNumber).Value _
& Workbooks(PDwb).Sheets("pivotdata").Range("E" & RowNumber).Value & Workbooks(PDwb).Sheets("pivotdata").Range("J" & RowNumber).Value


ActiveCell.Offset(1, 0).Select

Loop

INCwb.Close savechanges:=False

MsgBox ("Enter a BO Docment")

BODoc = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select File To Be Opened")
If BODoc = False Then Exit Sub
Set BOwb = Workbooks.Open(BODoc)

BOwb.Sheets("Stock Reconciliation").Range("B5").Select

Do Until IsEmpty(ActiveCell)

RowNumber = RowNumber + 1
BORowNumber = BORowNumber + 1

Workbooks(PDwb).Sheets("pivotdata").Range("B" & RowNumber).Value = "EDW"
Workbooks(PDwb).Sheets("pivotdata").Range("Q" & RowNumber & ":V" & RowNumber).Value = "0"
Workbooks(PDwb).Sheets("pivotdata").Range("K" & RowNumber & ":P" & RowNumber).Value = BOwb.Sheets("Stock Reconciliation").Range("I" & BORowNumber & ":N" & BORowNumber).Value
Workbooks(PDwb).Sheets("pivotdata").Range("J" & RowNumber).Value = Abs(Left(OnlyNums(BOwb.Sheets("Stock Reconciliation").Range("G" & BORowNumber).Value), 8))
Workbooks(PDwb).Sheets("pivotdata").Range("C" & RowNumber).Value = Abs(Left(OnlyNums(BOwb.Sheets("Stock Reconciliation").Range("E" & BORowNumber).Value), 8))
Workbooks(PDwb).Sheets("pivotdata").Range("H" & RowNumber).Value = Mid(BOwb.Sheets("Stock Reconciliation").Range("F" & BORowNumber).Value, 4, 3)
If BOwb.Sheets("Stock Reconciliation").Range("H" & BORowNumber).Value = "ON_HAND" Or BOwb.Sheets("Stock Reconciliation").Range("H" & BORowNumber).Value = "ON HAND" Then
Workbooks(PDwb).Sheets("pivotdata").Range("E" & RowNumber).Value = "ON-HAND"
Else
Workbooks(PDwb).Sheets("pivotdata").Range("E" & RowNumber).Value = Cell
End If

If (IsError(Application.VLookup(BOwb.Sheets("Stock Reconciliation").Range("D" & BORowNumber).Value, _
Workbooks(PDwb).Sheets("Ctrl").Range("$B$2:$C$84"), 2, False))) Then
Workbooks(PDwb).Sheets("pivotdata").Range("D" & RowNumber).Value = "*chk*"
Else
Workbooks(PDwb).Sheets("pivotdata").Range("D" & RowNumber).Value = _
Application.VLookup(BOwb.Sheets("Stock Reconciliation").Range("D" & BORowNumber).Value, _
Workbooks(PDwb).Sheets("Ctrl").Range("$B$2:$C$84"), 2, False)
End If

If (IsError(Application.VLookup(BOwb.Sheets("Stock Reconciliation").Range("F" & BORowNumber).Value, _
Workbooks(PDwb).Sheets("Ctrl").Range("$I:$N"), 2, False))) Then
Workbooks(PDwb).Sheets("pivotdata").Range("F" & RowNumber).Value = "*chk*"
Else
Workbooks(PDwb).Sheets("pivotdata").Range("F" & RowNumber).Value = _
Application.VLookup(BOwb.Sheets("Stock Reconciliation").Range("F" & BORowNumber).Value, _
Workbooks(PDwb).Sheets("Ctrl").Range("$I:$N"), 2, False)
End If

If (IsError(Application.VLookup(BOwb.Sheets("Stock Reconciliation").Range("F" & BORowNumber).Value, _
Workbooks(PDwb).Sheets("Ctrl").Range("$I:$N"), 3, False))) Then
Workbooks(PDwb).Sheets("pivotdata").Range("G" & RowNumber).Value = "*chk*"
Else
Workbooks(PDwb).Sheets("pivotdata").Range("G" & RowNumber).Value = _
Application.VLookup(BOwb.Sheets("Stock Reconciliation").Range("F" & BORowNumber).Value, _
Workbooks(PDwb).Sheets("Ctrl").Range("$I:$N"), 3, False)
End If

If (IsError(Application.VLookup(BOwb.Sheets("Stock Reconciliation").Range("F" & BORowNumber).Value, _
Workbooks(PDwb).Sheets("Ctrl").Range("$I:$N"), 5, False))) Then
Workbooks(PDwb).Sheets("pivotdata").Range("I" & RowNumber).Value = "*chk*"
Else
Workbooks(PDwb).Sheets("pivotdata").Range("I" & RowNumber).Value = _
Application.VLookup(BOwb.Sheets("Stock Reconciliation").Range("F" & BORowNumber).Value, _
Workbooks(PDwb).Sheets("Ctrl").Range("$I:$N"), 5, False)
End If

Workbooks(PDwb).Sheets("pivotdata").Range("A" & RowNumber).Value = Workbooks(PDwb).Sheets("pivotdata").Range("D" & RowNumber).Value _
& Workbooks(PDwb).Sheets("pivotdata").Range("E" & RowNumber).Value & Workbooks(PDwb).Sheets("pivotdata").Range("J" & RowNumber).Value

ActiveCell.Offset(1, 0).Select

Loop

Dim i As Long
Dim x As Long

For i = 2 To INCRowNumber
For x = (INCRowNumber + 1) To (INCRowNumber + BORowNumber)
If Workbooks(PDwb).Sheets("pivotdata").Range("A" & i).Value = Workbooks(PDwb).Sheets("pivotdata").Range("A" & x).Value Then

Workbooks(PDwb).Sheets("pivotdata").Range("W" & i).Value = "In Both"
Else
Workbooks(PDwb).Sheets("pivotdata").Range("W" & i).Value = "In INC - Not in EDW"
End If
Next x
Next i

Dim y As Long
Dim z As Long

For y = (INCRowNumber + 1) To (INCRowNumber + BORowNumber)
For z = 2 To INCRowNumber
If Workbooks(PDwb).Sheets("pivotdata").Range("A" & i).Value = Workbooks(PDwb).Sheets("pivotdata").Range("A" & x).Value Then
Workbooks(PDwb).Sheets("pivotdata").Range("W" & y).Value = "In Both"
Else
Workbooks(PDwb).Sheets("pivotdata").Range("W" & y).Value = "In EDW - Not in INC"
End If
Next z
Next y

BOwb.Close savechanges:=False


Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic


End Sub​

Many thanks, Dan

 

[Urtehnoes]

With issues like this, one of the best ways to figure it out is by executing the code one line at a time, or setting break points. You can execute each line one by one by pressing F8 to execute the line and move down one. When you press F8 a yellow cursor will appear on the left hand side of the line of code, and you can actually drag that to different parts of the code to execute. This really, really helps when you think you found the issue, and want to tweak the code a little bit without having to re-run everything.

The next tip for something like this, is using break points. Select a line of code, and press F9 to enter a break point (highlighting it red). When you run the macro the execution will automatically stop at this point and you can inspect certain things.

When a macro of mine freezes/crashes Excel, there can be many reasons. So what I'll do is if I know the first loop executes fine, I'll set a breakpoint (f9) at the 'Loop' line (above Dim X/I) and wait for Excel to execute the first loop. Then, before pressing F5 to continue, I'd set about 8-10 break points at random parts of the loop. The goal here is that you'll be able to see how many breakpoints Excel gets to before crashing. If it makes it to the first break point, great. But does it crash before reaching the second? Well at least now you have an area of the code you can focus on (or post here to for advice).

Let me know if I can clarify. Unfortunately I'm not able to tell what line of code could be causing Excel to crash, so this is the best suggestion I can make.