Forum Discussion
"Method 'Calculation' of object '_Application' failed" error occurs on unpredictable attempts
At random times, this save code decides to spit the "Method 'Calculation' of object '_Application' failed" error. It doesn't happen on any other userforms. Any idea why?
Private Sub CommandButton2_Click() 'Save
'Initial:
On Error Resume Next
Dim rng As Range, cell As Range
Dim first_DB_avail_row As Range
Dim Highest_Version_Row As Long
Dim existingVersions() As String
Dim ver_find As Variant
Dim ver_list As Object: Set ver_list = CreateObject("System.Collections.ArrayList") 'Use an ArrayList for version sorting
Dim padded_list As Object: Set padded_list = CreateObject("System.Collections.ArrayList") 'Create a temporary list for padded versions to ensure order (e.g., 5.1.28 > 5.1.2)
Dim v As Variant, parts As Variant
Dim padded_v As String, leadChar As String, all_vers As String
Dim i As Integer
'Validate entries:
If Me.Caption = "First Version - Business Manager" Then 'Adding product - first version
If Me.ComboBox1.Value = "" Or Me.TextBox1.Value = "" Or _
Me.TextBox2.Value = "" Or Me.TextBox3.Value = "" Then 'Check if version is not inputted
MsgBox "You must complete all fields.", vbExclamation, "Business Manager"
GoTo MEM_CLEAN
End If
Insert_Product.ver_val = stage_entry & Major & Minor & Patch
Unload Me
Insert_Product.new_product_ver_cancel = False 'Set back to false from the terminate sub setting
GoTo MEM_CLEAN
End If
Call Find_Latest_Ver 'Get the current latest version
If stage_entry & Major & Minor & Patch = Highest_Version Then 'Check if version already exists
MsgBox "This version already exists (as the newest version).", vbExclamation, "Business Manager"
GoTo MEM_CLEAN
End If
existingVersions = Split(Replace(Me.TextBox4.Value, vbCrLf, ""), "• ")
For Each ver_find In existingVersions
If Trim(ver_find) = Trim(stage_entry & Major & Minor & Patch) Then
MsgBox "This version already exists.", vbExclamation, "Business Manager"
GoTo MEM_CLEAN
End If
Next ver_find
If Me.ComboBox1.Value = "" Or Me.TextBox1.Value = "" Or _
Me.TextBox2.Value = "" Or Me.TextBox3.Value = "" Then 'Check if version is not inputted
MsgBox "You must complete all fields.", vbExclamation, "Business Manager"
GoTo MEM_CLEAN
End If
Me.Hide 'This will preserve public variables, keeping the form loaded, while still allowing the PLZ_WAIT userForm to display (no modal error)
'Macro Enhancement - Start:
Application.Calculation = xlCalculationManual
ActiveWorkbook.UpdateRemoteReferences = False
Application.EnableEvents = False 'This must be false
Application.ScreenUpdating = False
Application.Interactive = False
Application.DisplayAlerts = False
Application.DisplayStatusBar = False
PLZ_WAIT.Show
PLZ_WAIT.Label2.Caption = "Setting new version"
DoEvents 'Allows the PLZ_WAIT userForm to display
If Err.Number <> 0 Then 'For some unknown reason, the Excel error "Method 'Calculation' of object '_Application' failed" occurs on unpredictable/unrepeatable attempts to save (sub runs) - cause unknown
MsgBox "An Excel error occured (""" & Err.Description & """: " & Err.Number & "). Please try again (until it works).", vbExclamation, "Business Manager"
GoTo MEM_CLEAN
End If
'Pull data from the latest version:
ThisWorkbook.Sheets("Products").Unprotect Password:=ThisWorkbook.Sheets("Background Data").Range("CY39").Value
For Each cell In ThisWorkbook.Sheets("Background Data").Range("E4:E7503")
If cell.Value = ThisWorkbook.Sheets("Products").Range("E" & Selection.Row).Value Then
If cell.Offset(0, -2).Value = Highest_Version Then
ThisWorkbook.Sheets("Products").Range("B" & Selection.Row).Value = cell.Offset(0, -3).Value 'Name
ThisWorkbook.Sheets("Products").Range("C" & Selection.Row).Value = stage_entry & Major & Minor & Patch 'Product Version
ThisWorkbook.Sheets("Products").Range("D" & Selection.Row).Value = cell.Offset(0, -1).Value 'File
ThisWorkbook.Sheets("Products").Range("E" & Selection.Row).Value = cell.Value 'ID Number
ThisWorkbook.Sheets("Products").Range("F" & Selection.Row).Value = cell.Offset(0, 1).Value 'Category
ThisWorkbook.Sheets("Products").Range("G" & Selection.Row).Value = cell.Offset(0, 2).Value 'Details (Description)
ThisWorkbook.Sheets("Products").Range("K" & Selection.Row).Value = cell.Offset(0, 6).Value 'Release Date
ThisWorkbook.Sheets("Products").Range("L" & Selection.Row).Value = cell.Offset(0, 7).Value 'Copyright Y/N button
ThisWorkbook.Sheets("Products").Range("M" & Selection.Row).Value = cell.Offset(0, 8).Value 'Copyright Status
ThisWorkbook.Sheets("Products").Range("N" & Selection.Row).Value = cell.Offset(0, 9).Value 'Year
ThisWorkbook.Sheets("Products").Range("O" & Selection.Row).Value = cell.Offset(0, 10).Value 'Copyright Statement
ThisWorkbook.Sheets("Products").Range("P" & Selection.Row).Value = cell.Offset(0, 11).Value 'Published Y/N button
ThisWorkbook.Sheets("Products").Range("Q" & Selection.Row).Value = cell.Offset(0, 12).Value 'Publish Status (Date)
ThisWorkbook.Sheets("Products").Range("R" & Selection.Row).Value = cell.Offset(0, 13).Value 'Web Link
ThisWorkbook.Sheets("Products").Range("S" & Selection.Row).Value = cell.Offset(0, 14).Value 'Withdraw Date
Highest_Version_Row = cell.Row
Exit For
End If
End If
Next cell
'Save new version to version database:
Set first_DB_avail_row = ThisWorkbook.Sheets("Background Data").Range(ThisWorkbook.Sheets("Background Data").Range("C7506").End(xlUp).Offset(1, 0).Address)
first_DB_avail_row.Offset(0, -1).Value = ThisWorkbook.Sheets("Products").Range("B" & Selection.Row).Value 'Name
first_DB_avail_row.Value = ThisWorkbook.Sheets("Products").Range("C" & Selection.Row).Value 'Product Version
first_DB_avail_row.Offset(0, 1).Value = ThisWorkbook.Sheets("Products").Range("D" & Selection.Row).Value 'File
first_DB_avail_row.Offset(0, 2).Value = ThisWorkbook.Sheets("Products").Range("E" & Selection.Row).Value 'ID Number
first_DB_avail_row.Offset(0, 3).Value = ThisWorkbook.Sheets("Products").Range("F" & Selection.Row).Value 'Category
first_DB_avail_row.Offset(0, 4).Value = ThisWorkbook.Sheets("Products").Range("G" & Selection.Row).Value 'Details (Description)
first_DB_avail_row.Offset(0, 8).Value = ThisWorkbook.Sheets("Products").Range("K" & Selection.Row).Value 'Release Date
first_DB_avail_row.Offset(0, 9).Value = ThisWorkbook.Sheets("Products").Range("L" & Selection.Row).Value 'Copyright Y/N button
first_DB_avail_row.Offset(0, 10).Value = ThisWorkbook.Sheets("Products").Range("M" & Selection.Row).Value 'Copyright Status
first_DB_avail_row.Offset(0, 11).Value = ThisWorkbook.Sheets("Products").Range("N" & Selection.Row).Value 'Year
first_DB_avail_row.Offset(0, 12).Value = ThisWorkbook.Sheets("Products").Range("O" & Selection.Row).Value 'Copyright Statement
first_DB_avail_row.Offset(0, 13).Value = ThisWorkbook.Sheets("Products").Range("P" & Selection.Row).Value 'Published Y/N button
first_DB_avail_row.Offset(0, 14).Value = ThisWorkbook.Sheets("Products").Range("Q" & Selection.Row).Value 'Publish Status (Date)
first_DB_avail_row.Offset(0, 15).Value = ThisWorkbook.Sheets("Products").Range("R" & Selection.Row).Value 'Web Link
first_DB_avail_row.Offset(0, 16).Value = ThisWorkbook.Sheets("Products").Range("S" & Selection.Row).Value 'Withdraw Date
'Save Development Status Data to new version from latest version (copy over):
first_DB_avail_row.Offset(0, 17).Value = ThisWorkbook.Sheets("Background Data").Range("T" & Highest_Version_Row).Value 'Title
first_DB_avail_row.Offset(0, 18).Value = ThisWorkbook.Sheets("Background Data").Range("U" & Highest_Version_Row).Value 'Tags
first_DB_avail_row.Offset(0, 19).Value = ThisWorkbook.Sheets("Background Data").Range("V" & Highest_Version_Row).Value 'Content
first_DB_avail_row.Offset(0, 20).Value = ThisWorkbook.Sheets("Background Data").Range("W" & Highest_Version_Row).Value 'Total Tasks
first_DB_avail_row.Offset(0, 21).Value = ThisWorkbook.Sheets("Background Data").Range("X" & Highest_Version_Row).Value 'Complete Tasks
first_DB_avail_row.Offset(0, 22).Value = ThisWorkbook.Sheets("Background Data").Range("Y" & Highest_Version_Row).Value 'Platform
first_DB_avail_row.Offset(0, 23).Value = ThisWorkbook.Sheets("Background Data").Range("Z" & Highest_Version_Row).Value 'Medium
first_DB_avail_row.Offset(0, 24).Value = ThisWorkbook.Sheets("Background Data").Range("AA" & Highest_Version_Row).Value 'Framework
first_DB_avail_row.Offset(0, 25).Value = ThisWorkbook.Sheets("Background Data").Range("AB" & Highest_Version_Row).Value 'Stage
first_DB_avail_row.Offset(0, 26).Value = ThisWorkbook.Sheets("Background Data").Range("AC" & Highest_Version_Row).Value 'Dev Log (1)
first_DB_avail_row.Offset(0, 102).Value = ThisWorkbook.Sheets("Background Data").Range("DA" & Highest_Version_Row).Value 'Dev Log (2)
first_DB_avail_row.Offset(0, 103).Value = ThisWorkbook.Sheets("Background Data").Range("DB" & Highest_Version_Row).Value 'Dev Log (3)
first_DB_avail_row.Offset(0, 104).Value = ThisWorkbook.Sheets("Background Data").Range("DC" & Highest_Version_Row).Value 'Dev Log (4)
first_DB_avail_row.Offset(0, 105).Value = ThisWorkbook.Sheets("Background Data").Range("DD" & Highest_Version_Row).Value 'Dev Log (5)
first_DB_avail_row.Offset(0, 106).Value = ThisWorkbook.Sheets("Background Data").Range("DE" & Highest_Version_Row).Value 'Dev Log (6)
first_DB_avail_row.Offset(0, 107).Value = ThisWorkbook.Sheets("Background Data").Range("DF" & Highest_Version_Row).Value 'Dev Log (7)
first_DB_avail_row.Offset(0, 27).Value = ThisWorkbook.Sheets("Background Data").Range("AD" & Highest_Version_Row).Value 'Total Bugs
first_DB_avail_row.Offset(0, 28).Value = ThisWorkbook.Sheets("Background Data").Range("AE" & Highest_Version_Row).Value 'Resolved Bugs
first_DB_avail_row.Offset(0, 29).Value = ThisWorkbook.Sheets("Background Data").Range("AF" & Highest_Version_Row).Value 'Total Requests
first_DB_avail_row.Offset(0, 30).Value = ThisWorkbook.Sheets("Background Data").Range("AG" & Highest_Version_Row).Value 'Complete Requests
first_DB_avail_row.Offset(0, 31).Value = ThisWorkbook.Sheets("Background Data").Range("AH" & Highest_Version_Row).Value 'Start Date
first_DB_avail_row.Offset(0, 32).Value = ThisWorkbook.Sheets("Background Data").Range("AI" & Highest_Version_Row).Value 'End Date
first_DB_avail_row.Offset(0, 33).Value = ThisWorkbook.Sheets("Background Data").Range("AJ" & Highest_Version_Row).Value 'Total Work Days
first_DB_avail_row.Offset(0, 34).Value = ThisWorkbook.Sheets("Background Data").Range("AK" & Highest_Version_Row).Value 'Lines of Code
first_DB_avail_row.Offset(0, 35).Value = ThisWorkbook.Sheets("Background Data").Range("AL" & Highest_Version_Row).Value 'Number of Features/Amenities
first_DB_avail_row.Offset(0, 36).Value = ThisWorkbook.Sheets("Background Data").Range("AM" & Highest_Version_Row).Value 'Ease of Use
first_DB_avail_row.Offset(0, 37).Value = ThisWorkbook.Sheets("Background Data").Range("AN" & Highest_Version_Row).Value 'Innovation/Uniqueness
first_DB_avail_row.Offset(0, 38).Value = ThisWorkbook.Sheets("Background Data").Range("AO" & Highest_Version_Row).Value 'Complexity
first_DB_avail_row.Offset(0, 39).Value = ThisWorkbook.Sheets("Background Data").Range("AP" & Highest_Version_Row).Value 'Optimization
first_DB_avail_row.Offset(0, 40).Value = ThisWorkbook.Sheets("Background Data").Range("AQ" & Highest_Version_Row).Value 'Customer Request/Cater
'Set version list:
Set rng = ThisWorkbook.Sheets("Background Data").Range("E4:E7503")
ver_list.Add stage_entry & Major & Minor & Patch 'Add initial version
For Each cell In rng 'Loop to add matches - Collect all versions
If cell.Value = ThisWorkbook.Sheets("Products").Range("E" & Selection.Row).Value Then
ver_list.Add cell.Offset(0, -2).Value
End If
Next cell
'Temporarily convert each version into sortable key (000.000.000)
For i = 0 To ver_list.Count - 1
v = ver_list(i)
leadChar = Left(v, 1)
parts = Split(Mid(v, 2), ".")
padded_v = leadChar
padded_v = padded_v & Right("000" & parts(0), 3)
padded_v = padded_v & Right("000" & parts(1), 3)
padded_v = padded_v & Right("000" & parts(2), 3)
ver_list(i) = padded_v & "|" & v 'Store padded key + original version
'Note: This converts, for example, "V54.17.44" to "V054017044" in order to sort, for each version (i)
Next i
'Sort (descending) then strip padded key:
ver_list.Sort: ver_list.Reverse
For i = 0 To ver_list.Count - 1
ver_list(i) = Split(ver_list(i), "|")(1)
Next i
'Note: This sorts then reverses the sort for highest version to be on top. Since sorting is left-to-right, major number will sort first, then minor, _
then patch, in that order. For the release, order will be A then B then V, since that's the alphabet's order, then it's reversed causing the order to be V then B then A. _
Basically, it is sorted lexicographically (V > B > A) then numerically (000000000), then reversed for descending order, then converted back to versioning format.
'Set validation:
all_vers = " ," & Join(ver_list.ToArray, ",") 'Join all in array into one string and add initial blank option (for adding new when selected), for setting validation
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=all_vers
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = False
.ShowError = False
End With
ThisWorkbook.Sheets("Products").Protect Password:=ThisWorkbook.Sheets("Background Data").Range("CY39").Value
'Macro Enhancement - End:
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.UpdateRemoteReferences = True
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Interactive = True
Application.DisplayAlerts = True
Application.DisplayStatusBar = True
'Final:
Unload Me 'This clears "Highest_Version" and all public variables ?.......
Sheet2.UPDATE_DB_FORCE = True
Application.Run "Sheet2.Worksheet_Change", Selection 'Necessary in order to update Pricing and CUS_PRO_RATINGS sheets with new version
Sheet2.UPDATE_DB_FORCE = False
'Release variables/objects from memory:
MEM_CLEAN:
Unload PLZ_WAIT: Set PLZ_WAIT = Nothing
Set rng = Nothing
Set cell = Nothing
Set first_DB_avail_row = Nothing
ver_list.Clear: Set ver_list = Nothing
Set padded_list = Nothing
End Sub
2 Replies
The error "Method 'Calculation' of object '_Application' failed" is notoriously vague, but its intermittent nature is the biggest clue. It almost always points to a race condition or an unstable application state caused by how your code interacts with the Excel environment, especially when combined with userforms and screen updating.
I Think the error happens on this line: Application.Calculation = xlCalculationManual. You are trying to change a global application setting. The failure means Excel is in a state where it cannot process this request at that exact moment.
Here my solution approach with some Key Improvements (Replaced On Error Resume Next with a proper On Error GoTo ErrorHandler - The CleanExit block is now the only exit point, besides End Sub - The code now captures selectedRow = Selection.Row at the very beginning - The SetAppState helper sub makes the main code cleaner and less error-prone - The wait form is shown after the application state is set to "busy" - Using worksheet variables (wsProd, wsBkg) makes the code easier). Hope that Helps in your Projekt.
' Helper sub to manage application state Private Sub SetAppState(ByVal isBusy As Boolean) Static originalCalculation As XlCalculation Static originalEvents As Boolean Static originalScreenUpdating As Boolean Static originalUpdateRemoteRefs As Boolean Static originalDisplayStatusBar As Boolean If isBusy Then ' Store original states first time If originalCalculation = 0 Then originalCalculation = Application.Calculation originalEvents = Application.EnableEvents originalScreenUpdating = Application.ScreenUpdating originalUpdateRemoteRefs = ActiveWorkbook.UpdateRemoteReferences originalDisplayStatusBar = Application.DisplayStatusBar End If ' Turn everything OFF for speed/stability On Error Resume Next ' Just in case calculation change fails Application.Calculation = xlCalculationManual Application.EnableEvents = False Application.ScreenUpdating = False ActiveWorkbook.UpdateRemoteReferences = False Application.DisplayStatusBar = False On Error GoTo 0 Else ' Restore original states On Error Resume Next If originalCalculation <> 0 Then Application.Calculation = originalCalculation Application.EnableEvents = originalEvents Application.ScreenUpdating = originalScreenUpdating ActiveWorkbook.UpdateRemoteReferences = originalUpdateRemoteRefs Application.DisplayStatusBar = originalDisplayStatusBar Else ' Fallback to defaults Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Application.ScreenUpdating = True ActiveWorkbook.UpdateRemoteReferences = True Application.DisplayStatusBar = True End If On Error GoTo 0 ' Reset stored states originalCalculation = 0 End If End Sub Private Sub CommandButton2_Click() 'Save ' --- PREPARATION --- ' Declare all variables at the top Dim wsProd As Worksheet, wsBkg As Worksheet Dim rng As Range, cell As Range Dim first_DB_avail_row As Range Dim Highest_Version_Row As Long Dim existingVersions() As String Dim ver_find As Variant Dim ver_list As Object: Set ver_list = CreateObject("System.Collections.ArrayList") Dim padded_list As Object: Set padded_list = CreateObject("System.Collections.ArrayList") Dim v As Variant, parts As Variant Dim padded_v As String, leadChar As String, all_vers As String Dim i As Long 'Use Long instead of Integer for row counts Dim productID_To_Find As String Dim newVersionString As String Dim selectedRow As Long '*** CRITICAL: Store the selected row number explicitly *** Dim destRow As Range Dim srcDevRow As Range ' --- INITIAL SETUP & VALIDATION --- On Error GoTo ErrorHandler 'Use a proper error handler ' Set worksheet objects to avoid repeated lookups Set wsProd = ThisWorkbook.Sheets("Products") Set wsBkg = ThisWorkbook.Sheets("Background Data") ' *** CRITICAL FIX: Capture the active row BEFORE any UI changes *** If TypeName(Selection) <> "Range" Then MsgBox "Please select a product row first.", vbExclamation, "Business Manager" GoTo CleanExit End If selectedRow = Selection.Row If selectedRow < 4 Then 'Basic validation - assuming data starts at row 4 MsgBox "Please select a valid product row (row 4 or greater).", vbExclamation, "Business Manager" GoTo CleanExit End If productID_To_Find = wsProd.Range("E" & selectedRow).Value If productID_To_Find = "" Then MsgBox "The selected row does not have a Product ID.", vbExclamation, "Business Manager" GoTo CleanExit End If newVersionString = stage_entry & Major & Minor & Patch 'Handle first version case If Me.Caption = "First Version - Business Manager" Then If Me.ComboBox1.Value = "" Or Me.TextBox1.Value = "" Or _ Me.TextBox2.Value = "" Or Me.TextBox3.Value = "" Then MsgBox "You must complete all fields.", vbExclamation, "Business Manager" GoTo CleanExit End If Insert_Product.ver_val = newVersionString Unload Me Insert_Product.new_product_ver_cancel = False GoTo CleanExit End If ' Validate entries for non-first version If Me.ComboBox1.Value = "" Or Me.TextBox1.Value = "" Or _ Me.TextBox2.Value = "" Or Me.TextBox3.Value = "" Then MsgBox "You must complete all version fields.", vbExclamation, "Business Manager" GoTo CleanExit End If 'Check for existing versions Call Find_Latest_Ver 'Get the current latest version If newVersionString = Highest_Version Then MsgBox "This version already exists (as the newest version).", vbExclamation, "Business Manager" GoTo CleanExit End If If Me.TextBox4.Value <> "" Then existingVersions = Split(Replace(Me.TextBox4.Value, vbCrLf, ""), "• ") For Each ver_find In existingVersions If Trim(ver_find) = newVersionString Then MsgBox "This version already exists.", vbExclamation, "Business Manager" GoTo CleanExit End If Next ver_find End If ' --- START LONG-RUNNING PROCESS --- Me.Hide 'Hide the form ' Set application state for performance/stability SetAppState True ' Show wait form modelessly PLZ_WAIT.Show vbModeless PLZ_WAIT.Label2.Caption = "Setting new version..." DoEvents ' --- CORE LOGIC --- ' Unprotect sheet wsProd.Unprotect Password:=wsBkg.Range("CY39").Value ' Pull data from the latest version Dim foundLatest As Boolean foundLatest = False Set rng = wsBkg.Range("E4:E7503") For Each cell In rng.Cells If cell.Value = productID_To_Find Then If cell.Offset(0, -2).Value = Highest_Version Then ' Copy values from the latest version's row to the selected row With wsProd.Rows(selectedRow) .Cells(1, "B").Value = cell.Offset(0, -3).Value 'Name .Cells(1, "C").Value = newVersionString 'Product Version .Cells(1, "D").Value = cell.Offset(0, -1).Value 'File .Cells(1, "E").Value = cell.Value 'ID Number .Cells(1, "F").Value = cell.Offset(0, 1).Value 'Category .Cells(1, "G").Value = cell.Offset(0, 2).Value 'Details (Description) .Cells(1, "K").Value = cell.Offset(0, 6).Value 'Release Date .Cells(1, "L").Value = cell.Offset(0, 7).Value 'Copyright Y/N button .Cells(1, "M").Value = cell.Offset(0, 8).Value 'Copyright Status .Cells(1, "N").Value = cell.Offset(0, 9).Value 'Year .Cells(1, "O").Value = cell.Offset(0, 10).Value 'Copyright Statement .Cells(1, "P").Value = cell.Offset(0, 11).Value 'Published Y/N button .Cells(1, "Q").Value = cell.Offset(0, 12).Value 'Publish Status (Date) .Cells(1, "R").Value = cell.Offset(0, 13).Value 'Web Link .Cells(1, "S").Value = cell.Offset(0, 14).Value 'Withdraw Date End With Highest_Version_Row = cell.Row foundLatest = True Exit For End If End If Next cell If Not foundLatest Then MsgBox "Could not find the data for the latest version ('" & Highest_Version & "') to copy from.", vbCritical, "Error" GoTo ErrorHandler End If ' Save new version to version database Set first_DB_avail_row = wsBkg.Range("C7506").End(xlUp).Offset(1, 0) Set destRow = first_DB_avail_row.EntireRow ' Copy product data to database destRow.Cells(1, "B").Value = wsProd.Cells(selectedRow, "B").Value 'Name destRow.Cells(1, "C").Value = wsProd.Cells(selectedRow, "C").Value 'Product Version destRow.Cells(1, "D").Value = wsProd.Cells(selectedRow, "D").Value 'File destRow.Cells(1, "E").Value = wsProd.Cells(selectedRow, "E").Value 'ID Number destRow.Cells(1, "F").Value = wsProd.Cells(selectedRow, "F").Value 'Category destRow.Cells(1, "G").Value = wsProd.Cells(selectedRow, "G").Value 'Details (Description) destRow.Cells(1, "K").Value = wsProd.Cells(selectedRow, "K").Value 'Release Date destRow.Cells(1, "L").Value = wsProd.Cells(selectedRow, "L").Value 'Copyright Y/N button destRow.Cells(1, "M").Value = wsProd.Cells(selectedRow, "M").Value 'Copyright Status destRow.Cells(1, "N").Value = wsProd.Cells(selectedRow, "N").Value 'Year destRow.Cells(1, "O").Value = wsProd.Cells(selectedRow, "O").Value 'Copyright Statement destRow.Cells(1, "P").Value = wsProd.Cells(selectedRow, "P").Value 'Published Y/N button destRow.Cells(1, "Q").Value = wsProd.Cells(selectedRow, "Q").Value 'Publish Status (Date) destRow.Cells(1, "R").Value = wsProd.Cells(selectedRow, "R").Value 'Web Link destRow.Cells(1, "S").Value = wsProd.Cells(selectedRow, "S").Value 'Withdraw Date ' Copy Development Status Data from latest version Set srcDevRow = wsBkg.Rows(Highest_Version_Row) ' Use bulk copy for efficiency destRow.Cells(1, "T").Resize(1, 7).Value = srcDevRow.Cells(1, "T").Resize(1, 7).Value 'Title through Dev Log (1) destRow.Cells(1, "AA").Resize(1, 3).Value = srcDevRow.Cells(1, "AA").Resize(1, 3).Value 'Framework through Stage destRow.Cells(1, "DA").Resize(1, 7).Value = srcDevRow.Cells(1, "DA").Resize(1, 7).Value 'Dev Logs (2-7) destRow.Cells(1, "AD").Resize(1, 13).Value = srcDevRow.Cells(1, "AD").Resize(1, 13).Value 'Bugs through Customer Request ' --- VERSION LIST & VALIDATION --- ' Build version list ver_list.Add newVersionString For Each cell In rng.Cells If cell.Value = productID_To_Find Then ver_list.Add cell.Offset(0, -2).Value End If Next cell ' Sort versions with padding technique For i = 0 To ver_list.Count - 1 v = ver_list(i) If Len(v) > 0 And Left(v, 1) Like "[A-Z]" And InStr(v, ".") > 0 Then leadChar = Left(v, 1) parts = Split(Mid(v, 2), ".") If UBound(parts) >= 2 Then padded_v = leadChar padded_v = padded_v & Right("000" & parts(0), 3) padded_v = padded_v & Right("000" & parts(1), 3) padded_v = padded_v & Right("000" & parts(2), 3) ver_list(i) = padded_v & "|" & v End If End If Next i ' Sort descending ver_list.Sort ver_list.Reverse ' Reconstruct version list For i = 0 To ver_list.Count - 1 If InStr(ver_list(i), "|") > 0 Then ver_list(i) = Split(ver_list(i), "|")(1) End If Next i ' Create validation list string all_vers = "," & Join(ver_list.ToArray, ",") ' Apply validation to the version cell With wsProd.Cells(selectedRow, "C").Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=all_vers .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = False .ShowError = False End With ' Re-protect sheet wsProd.Protect Password:=wsBkg.Range("CY39").Value ' --- FINALIZATION --- Sheet2.UPDATE_DB_FORCE = True ' Pass the specific cell that changed Application.Run "Sheet2.Worksheet_Change", wsProd.Cells(selectedRow, "C") Sheet2.UPDATE_DB_FORCE = False MsgBox "New version '" & newVersionString & "' created successfully!", vbInformation, "Success" Unload Me CleanExit: ' This section runs whether there's an error or not ' Restore application state SetAppState False ' Clean up UI On Error Resume Next Unload PLZ_WAIT On Error GoTo 0 ' Release all object variables Set wsProd = Nothing Set wsBkg = Nothing Set rng = Nothing Set cell = Nothing Set first_DB_avail_row = Nothing Set destRow = Nothing Set srcDevRow = Nothing If Not ver_list Is Nothing Then ver_list.Clear Set ver_list = Nothing End If Set padded_list = Nothing Exit Sub 'Normal exit ErrorHandler: ' This section only runs when an actual error occurs MsgBox "An unexpected error occurred:" & vbCrLf & _ "Error #" & Err.Number & ": " & Err.Description & vbCrLf & _ "The operation has been cancelled. Please try again.", vbCritical, "Business Manager" ' Jump to cleanup section to restore state Resume CleanExit End SubThe code is not Tested, save your file as a backup before.
Hello again :) Thank you for the insight! I'm not too familiar with what a Static variable is but hasn't been tried in my work yet. With that said, across all my userforms, I pretty much do a variable declare, then validation, then set macro enhancement, then the code. This one just doesn't set any of the application states ("Macro Enhancement - Start:") sometimes, but then other times, does it with no issues at all. I would get the error 1 time then good for 3 times of save in a row, or: 2-to-4, 1-to-6, 3-to-1, or any random consecutive number of error-to-good times.
No issues in other userforms and would be good random times in this one so it doesn't make sense. Anyway, what I wanted to ask before trying that is if I can keep this in one sub and have my same "MEM_CLEAN:" structure, before moving on with your suggestions?
