'Excels Graphical Issue
So although Excel not being made to create programs in, I'm completing one. Rest of the workbook works great but facing an issue with a sub which I'm yet to find anyone else having: (Images at the bottom)
https://i.stack.imgur.com/bWoEc.png https://i.stack.imgur.com/4pGQN.png
The sub will look at sheet 1 where it will fill sheet 2 with data accordingly, then sheet 3 will take that data and analyse it and present it nicely to the user who ran it. The error occurs mid macro where it pulls bits of each sheet referenced and graphically merges them. Once the macro finishes it remains broken until you go onto sheet 2 then back to 3, for the users this isn't really what I wanted.
Unsure if this is a limiation of Excel or if there is a method to force excel to dedicate some memory to keeping sheet 3 intact?
Macro is fully below: Please note where I am selecting sheets is where I was troubleshooting
'This Sub will help calculate the % of Role Recomeneded Training. It will decide if the training for selected user is complete
Sub CalculateTrainingAnaltics()
'-------------------------------------Role Based Training Analysis-------------------------------------
'Unprotect Sheets to allow for calculations and changes
Sheets("UserAnalysis").Unprotect
Sheets("TrainingMatrixRe-Work").Unprotect
Sheets("ManageUsers").Unprotect
'Declare global Variables
Dim userToCal As String
Dim rowToCal As String
Dim roleNeeded As String
Dim cellToCheckC As String
Dim holdCellNumber As String 'Temp Var meant to be over written
Dim calcol As String 'Column to place findings into
Dim progressBar As Integer
'Reset Progress Bar
Sheets("UserAnalysis").Range("B30") = progressBar
Sheets("UserAnalysis").Range("B31") = progressBar
'Go Back To orignal Sheet and reset graphical issues
Sheets("Dashboard").Select
MsgBox "Calculation now starting"
Sheets("ManageUsers").Select
userToCal = Range("D5")
'MsgBox userToCal & " Column to Calculate" 'Debug line
'Loops to compare all training
For i = 0 To 298
progressBar = i
Sheets("UserAnalysis").Range("B30") = progressBar
holdCellNumber = "" ' Clear before every use
cellToCheckC = "" ' Clear before every use
holdCellNumber = i + 9
cellToCheckC = "C" + holdCellNumber
'MsgBox cellToCheckC 'Debug Message
roleNeeded = Sheets("UserAnalysis").Range(cellToCheckC)
'Go Back To orignal Sheet and reset graphical issues
If i = 50 Then
Sheets("Dashboard").Select
Sheets("ManageUsers").Select
End If
If roleNeeded = 1 Then
holdCellNumber = "" ' Clear before every use
userToCal = Sheets("UserAnalysis").Range("D5") ' Re-applies before every use
holdCellNumber = i + 5
userToCal = userToCal + holdCellNumber
If Sheets("TrainingMatrixRe-Work").Range(userToCal) = "" Then
calcol = "" ' Clear before every use
holdCellNumber = "" ' Clear before every use
holdCellNumber = i + 9
calcol = "D" + holdCellNumber
Sheets("UserAnalysis").Range(calcol) = "Incomplete"
Else
calcol = "" ' Clear before every use
holdCellNumber = "" ' Clear before every use
holdCellNumber = i + 9
calcol = "D" + holdCellNumber
Sheets("UserAnalysis").Range(calcol) = "Completed"
End If
Else
calcol = "" ' Clear before every use
holdCellNumber = "" ' Clear before every use
holdCellNumber = i + 9
calcol = "D" + holdCellNumber
Sheets("UserAnalysis").Range(calcol) = "Not Needed"
End If
Next
'-------------------------------------Training Compliance-------------------------------------------------------------------
'Go Back To orignal Sheet and reset graphical issues
Sheets("Dashboard").Select
Sheets("ManageUsers").Select
Dim placeCalcu As String
Dim rowToPlace As String
For i = 0 To 298
progressBar = i
Sheets("UserAnalysis").Range("B31") = progressBar
'Go Back To orignal Sheet and reset graphical issues
If i = 50 Then
Sheets("Dashboard").Select
Sheets("ManageUsers").Select
End If
holdCellNumber = "" ' Clear before every use
userToCal = ""
userToCal = Sheets("UserAnalysis").Range("E5") ' Re-applies before every use
holdCellNumber = i + 603
userToCal = userToCal + holdCellNumber
'MsgBox userToCal
If Sheets("TM-TimeFormatting").Range(userToCal) = True Then
'MsgBox "Checking OUT OF DATE"
rowToPlace = ""
placeCalcu = "E"
rowToPlace = i + 9
placeCalcu = placeCalcu + rowToPlace
'MsgBox placeCalcu 'Debug Line
Sheets("UserAnalysis").Range(placeCalcu) = "Out Of Date"
Else
'Now we'll pull if the data has expired or near EOL or 3 Months or More Left
holdCellNumber = "" ' Clear before every use
userToCal = Sheets("UserAnalysis").Range("E5") ' Re-applies before every use
holdCellNumber = i + 304
userToCal = userToCal + holdCellNumber
'Test for if the training is out of date
If Sheets("TM-TimeFormatting").Range(userToCal) = True Then
placeCalcu = "E"
rowToPlace = i + 9
placeCalcu = placeCalcu + rowToPlace
'MsgBox ("Checking") 'Debug Line
Sheets("UserAnalysis").Range(placeCalcu) = "Near EOL"
Else
holdCellNumber = "" ' Clear before every use
userToCal = ""
userToCal = Sheets("UserAnalysis").Range("E5") ' Re-applies before every use
holdCellNumber = i + 902
userToCal = userToCal + holdCellNumber
If Sheets("TM-TimeFormatting").Range(userToCal) = True Then
rowToPlace = ""
placeCalcu = "E"
rowToPlace = i + 9
placeCalcu = placeCalcu + rowToPlace
'MsgBox placeCalcu 'Debug Line
Sheets("UserAnalysis").Range(placeCalcu) = "Compliant"
Else
If Sheets("TrainingMatrixRe-Work").Range(userToCal) = 0 Then
'Where to place not complete
placeCalcu = "E"
rowToPlace = i + 9
placeCalcu = placeCalcu + rowToPlace
'If its not then apply Not completed
Sheets("UserAnalysis").Range(placeCalcu) = "Not Completed"
End If
End If
End If
End If
Next
'-----------------------------------------------------------------------------------------------------------
'Refresh the pivot table and pie chart
Dim Table As PivotCache
For Each Table In ThisWorkbook.PivotCaches
Table.Refresh
Next Table
'Go Back To orignal Sheet and reset graphical issues
Sheets("Dashboard").Select
Sheets("ManageUsers").Select
'Sheets("Dashboard").Select
'Complete Msg
MsgBox "Calculation Complete - Please see information :)"
'Sheets("ManageUsers").Select
'Reprotect All of Working Sheets
Sheets("UserAnalysis").Protect
Sheets("TrainingMatrixRe-Work").Protect
Sheets("ManageUsers").Protect
End SUB
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|