Frozen Worksheet / Navigation after VBA Script runs

[Gturner123]

Hi

I am looking for assistance, because I have a problem with a script i'm running, and I've been unable to find any guidance online yet.

The script runs fine, compiling data into one worksheet, from various others. It contains do-while loops, and an amount of taking data from one place, putting it into another.

however, when the script finishes; it carries out all instructions, right to the last command, without problem. There is no hanging, crashing or "not responding" issues.

But, when the script takes me to the worksheet and concludes the lines of code. I find that the worksheet is in a semi-frozen state.

The issues are;
"the navigation keys on my keyboard don't work"
"Mouse wheel scrolling" - moves the vertical scroll bar up/down, but nothing moves on the screen. (there is no screen refreshing going on)
The Tab key - moves the horizontal scroll bar left/right, but again, no screen refreshing, so no data / columns move on the screen
The enter key drops me one row each time (seems to work okay)

I cannot seem to stop this happening, but i cannot see what is causing the issue in the script. A copy of the code is below

Has anyone any ideas where i should be looking to resolve this?

With thanks in advance

Gavin


Dim wb As Workbook
Dim Lrow As Long
Dim Currow As Long
Dim SummarySheetCurrow As Long
Dim CurSpend As Double
Dim ScenASpend As Double
Dim ScenBSpend As Double
Dim ScenASpendPercent As Double
Dim ScenBSpendPercent As Double


Application.ScreenUpdating = False
Set wb = ThisWorkbook

wb.Worksheets("PMLExtract").Activate
wb.Worksheets("Summaryofchanges").Unprotect
Range("A1048576").End(xlUp).Select
Lrow = ActiveCell.Row
Currow = 2
SummarySheetCurrow = 2

Application.ScreenUpdating = False
Do While Currow <= Lrow
ScenASpend = 0
ScenBSpend = 0
CurSpend = 0

wb.Worksheets("SummaryOfChanges").Range("A" & SummarySheetCurrow) = wb.Worksheets("PMLExtract").Range("A" & Currow)
wb.Worksheets("SummaryOfChanges").Range("B" & SummarySheetCurrow) = wb.Worksheets("PMLExtract").Range("D" & Currow)
wb.Worksheets("SummaryOfChanges").Range("C" & SummarySheetCurrow) = wb.Worksheets("PMLExtract").Range("I" & Currow)
If wb.Worksheets("PMLExtract").Range("Z" & Currow) <> "" Then
wb.Worksheets("SummaryOfChanges").Range("D" & SummarySheetCurrow) = wb.Worksheets("PMLExtract").Range("Z" & Currow)
wb.Worksheets("SummaryOfChanges").Range("E" & SummarySheetCurrow) = "FIXED"
wb.Worksheets("SummaryOfChanges").Range("F" & SummarySheetCurrow) = Format(wb.Worksheets("PMLExtract").Range("AB" & Currow), "###,##0.00")
Else
wb.Worksheets("SummaryOfChanges").Range("D" & SummarySheetCurrow) = wb.Worksheets("PMLExtract").Range("AM" & Currow)
wb.Worksheets("SummaryOfChanges").Range("E" & SummarySheetCurrow) = "LPP"
wb.Worksheets("SummaryOfChanges").Range("F" & SummarySheetCurrow) = Format(wb.Worksheets("PMLExtract").Range("AN" & Currow), "###,##0.00")
End If
wb.Worksheets("SummaryOfChanges").Range("G" & SummarySheetCurrow) = Format(wb.Worksheets("PMLExtract").Range("CE" & Currow), "###,##0.00")
If wb.Worksheets("PMLExtract").Range("CE" & Currow) = "." Or wb.Worksheets("PMLExtract").Range("CE" & Currow) = "" Then
CurSpend = 0
Else
CurSpend = wb.Worksheets("PMLExtract").Range("CE" & Currow)
End If
wb.Worksheets("SummaryOfChanges").Range("H" & SummarySheetCurrow) = wb.Worksheets("PMLExtract").Range("BA" & Currow)
wb.Worksheets("SummaryOfChanges").Range("I" & SummarySheetCurrow) = Format(wb.Worksheets("PMLExtract").Range("BB" & Currow), "###,##0.00")
wb.Worksheets("SummaryOfChanges").Range("J" & SummarySheetCurrow) = Format(wb.Worksheets("PMLExtract").Range("BG" & Currow), "###,##0.00")
ScenASpend = wb.Worksheets("PMLExtract").Range("BG" & Currow)
ScenBSpend = wb.Worksheets("PMLExtract").Range("BP" & Currow)
wb.Worksheets("SummaryOfChanges").Range("K" & Currow) = Format(Application.WorksheetFunction.Round(Application.WorksheetFunction.Sum(ScenASpend - CurSpend), 2), "###,##0.00")
wb.Worksheets("SummaryOfChanges").Range("P" & Currow) = Format(Application.WorksheetFunction.Round(Application.WorksheetFunction.Sum(ScenBSpend - CurSpend), 2), "###,##0.00")
If ScenASpend > 0 And CurSpend > 0 Then
ScenASpendPercent = Application.WorksheetFunction.Round(Application.WorksheetFunction.Sum((ScenASpend - CurSpend) / CurSpend), 2)
If CurSpend = ScenASpend Then
wb.Worksheets("SummaryOfChanges").Range("L" & SummarySheetCurrow) = "0%"
Else
wb.Worksheets("SummaryOfChanges").Range("L" & SummarySheetCurrow) = Format(ScenASpendPercent, "%###.##")
End If
End If
wb.Worksheets("SummaryOfChanges").Range("M" & SummarySheetCurrow) = wb.Worksheets("PMLExtract").Range("BJ" & Currow)
wb.Worksheets("SummaryOfChanges").Range("N" & SummarySheetCurrow) = Format(wb.Worksheets("PMLExtract").Range("BK" & Currow), "###,##0.00")
wb.Worksheets("SummaryOfChanges").Range("O" & SummarySheetCurrow) = Format(wb.Worksheets("PMLExtract").Range("BP" & Currow), "###,##0.00")

If ScenBSpend > 0 And CurSpend > 0 Then
ScenBSpendPercent = Application.WorksheetFunction.Round(Application.WorksheetFunction.Sum((ScenBSpend - CurSpend) / CurSpend), 2)
If CurSpend = ScenBSpend Then
wb.Worksheets("SummaryOfChanges").Range("Q" & SummarySheetCurrow) = "0%"
Else
wb.Worksheets("SummaryOfChanges").Range("Q" & SummarySheetCurrow) = Format(ScenBSpendPercent, "%###.##")
End If
End If

If wb.Worksheets("SummaryOfChanges").Range("K" & SummarySheetCurrow) < 0 Then
wb.Worksheets("SummaryOfChanges").Range("K" & SummarySheetCurrow).Font.Color = vbRed
Else
wb.Worksheets("SummaryOfChanges").Range("K" & SummarySheetCurrow).Font.Color = vbBlack
End If
If wb.Worksheets("SummaryOfChanges").Range("P" & SummarySheetCurrow) < 0 Then
wb.Worksheets("SummaryOfChanges").Range("P" & SummarySheetCurrow).Font.Color = vbRed
Else
wb.Worksheets("SummaryOfChanges").Range("P" & SummarySheetCurrow).Font.Color = vbBlack
End If


If wb.Worksheets("SummaryOfChanges").Range("L" & SummarySheetCurrow) < 0 Then
wb.Worksheets("SummaryOfChanges").Range("L" & SummarySheetCurrow).Font.Color = vbRed
Else
wb.Worksheets("SummaryOfChanges").Range("L" & SummarySheetCurrow).Font.Color = vbBlack
End If
If wb.Worksheets("SummaryOfChanges").Range("Q" & SummarySheetCurrow) < 0 Then
wb.Worksheets("SummaryOfChanges").Range("Q" & SummarySheetCurrow).Font.Color = vbRed
Else
wb.Worksheets("SummaryOfChanges").Range("Q" & SummarySheetCurrow).Font.Color = vbBlack
End If

Currow = Currow + 1
SummarySheetCurrow = SummarySheetCurrow + 1
wb.Worksheets("SummaryofChanges").Visible = True
wb.Worksheets("SummaryofChanges").Activate

Loop


wb.Worksheets("SummaryOfChanges").Range("A2:Q" & Lrow).Font.Name = "HP Simplified"
wb.Worksheets("SummaryOfChanges").Range("A2:Q" & Lrow).HorizontalAlignment = xlCenter
wb.Worksheets("SummaryOfChanges").Range("A2:Q" & Lrow).Font.size = 9
wb.Worksheets("SummaryOfChanges").Columns("A:Q").AutoFit
Unload Me
Application.ScreenUpdating = True

End Sub

 

[Gturner123]

and a couple more issues i failed to mention above.

**
you can't do anything in the worksheet, - not even clicking on the "x" in top right, doesn't trigger a close command.
The only way around it, seems to be to click on another worksheet tab, or another workbook; This comes out of the worksheet, and when you return to the original worksheet which had the issue; the worksheet interacts as normal. No continued issues.

 

[BugBitten]

Hi Gavin

I had the same issue, running Ron De Bruin's Pop up menu.

My code to operate the menu was called from a Form Button Control. This caused the mouse wheel to fail and although the scroll bar was moving when the mouse wheel was used, the sheet remained fixed. The arrow keys froze. In fact sometimes it caused excel to completely crash and nothing would work!

The answer for me was to call the code from an Active X button control. This completely resolved the issues you describe, for me, and the sheet scrolling and keyboard functionality use were fully retained.

How is your code called? Is this perhaps a resolution for you?

Best wishes