Frozen Worksheet / Navigation after VBA Script runs

Gturner123

New Member
Joined
Jun 6, 2016
Messages
2
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
 

Some videos you may like

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

Gturner123

New Member
Joined
Jun 6, 2016
Messages
2
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

New Member
Joined
Oct 8, 2009
Messages
4
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
 

Watch MrExcel Video

Forum statistics

Threads
1,127,100
Messages
5,622,722
Members
415,923
Latest member
Kam80

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top