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
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