"Method 'Calculation' of object '_Application' failed" error occurs on unpredictable attempts

im no sure but you can try this code, maybe helps

Private Sub CommandButton2_Click() 'Save
    ' --- PREPARATION ---
    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 v As Variant, parts As Variant
    Dim padded_v As String, leadChar As String, all_vers As String
    Dim i As Long 'Changed to Long
    Dim selectedRow As Long
    Dim productID_To_Find As String
    Dim newVersionString As String
    
    ' *** THE FIX: Add a flag to track if we locked the app ***
    Dim appLocked As Boolean
    appLocked = False
    
    ' Set worksheet objects early
    Dim wsProd As Worksheet, wsBkg As Worksheet
    Set wsProd = ThisWorkbook.Sheets("Products")
    Set wsBkg = ThisWorkbook.Sheets("Background Data")

    ' --- INITIAL SETUP & VALIDATION ---
    If TypeName(Selection) = "Range" Then
        selectedRow = Selection.Row
    Else
        MsgBox "Please select a valid product row.", vbExclamation, "Business Manager"
        GoTo MEM_CLEAN
    End If

    If selectedRow < 4 Then
        MsgBox "Please select a valid product row (row 4 or greater).", vbExclamation, "Business Manager"
        GoTo MEM_CLEAN
    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 MEM_CLEAN
    End If
    
    newVersionString = stage_entry & Major & Minor & Patch

    ' Validation blocks (First Version)
    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 MEM_CLEAN
        End If
        Insert_Product.ver_val = newVersionString
        Unload Me
        Insert_Product.new_product_ver_cancel = False
        GoTo MEM_CLEAN
    End If
    
    ' Validation (Existing Version)
    Call Find_Latest_Ver
    If newVersionString = Highest_Version Then
        MsgBox "This version already exists (as the newest version).", vbExclamation, "Business Manager"
        GoTo MEM_CLEAN
    End If
    
    If Me.TextBox4.Value <> "" Then
        existingVersions = Split(Replace(Me.TextBox4.Value, vbCrLf, ""), "• ")
        For Each ver_find In existingVersions
            If Trim(ver_find) = Trim(newVersionString) Then
                MsgBox "This version already exists.", vbExclamation, "Business Manager"
                GoTo MEM_CLEAN
            End If
        Next ver_find
    End If

    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 MEM_CLEAN
    End If

    ' --- MACRO ENHANCEMENT - START ---
    Me.Hide
    
    ' Show wait form
    PLZ_WAIT.Show vbModeless
    PLZ_WAIT.Label2.Caption = "Setting new version"
    DoEvents 'Allow UI to paint
    
    ' *** THE CRITICAL FIX ***
    On Error Resume Next
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    ' Check if we actually succeeded
    If Err.Number = 0 Then
        appLocked = True 'We successfully locked it
    Else
        ' We failed to lock it. Clear error and proceed anyway (slower but safer)
        Err.Clear
        appLocked = False
    End If
    On Error GoTo ErrorHandler 'Restore normal error handling for logic errors
    
    ' We can still try these even if Calc failed
    ActiveWorkbook.UpdateRemoteReferences = False
    Application.DisplayAlerts = False
    Application.DisplayStatusBar = False
    ' Note: I removed Interactive=False as it often causes more issues than it solves

    ' Pull data from the latest version:
    wsProd.Unprotect Password:=wsBkg.Range("CY39").Value
    
    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 data using your logic
                wsProd.Rows(selectedRow).Cells(1, "B").Value = cell.Offset(0, -3).Value
                wsProd.Rows(selectedRow).Cells(1, "C").Value = newVersionString
                wsProd.Rows(selectedRow).Cells(1, "D").Value = cell.Offset(0, -1).Value
                wsProd.Rows(selectedRow).Cells(1, "E").Value = cell.Value
                wsProd.Rows(selectedRow).Cells(1, "F").Value = cell.Offset(0, 1).Value
                wsProd.Rows(selectedRow).Cells(1, "G").Value = cell.Offset(0, 2).Value
                wsProd.Rows(selectedRow).Cells(1, "K").Value = cell.Offset(0, 6).Value
                wsProd.Rows(selectedRow).Cells(1, "L").Value = cell.Offset(0, 7).Value
                wsProd.Rows(selectedRow).Cells(1, "M").Value = cell.Offset(0, 8).Value
                wsProd.Rows(selectedRow).Cells(1, "N").Value = cell.Offset(0, 9).Value
                wsProd.Rows(selectedRow).Cells(1, "O").Value = cell.Offset(0, 10).Value
                wsProd.Rows(selectedRow).Cells(1, "P").Value = cell.Offset(0, 11).Value
                wsProd.Rows(selectedRow).Cells(1, "Q").Value = cell.Offset(0, 12).Value
                wsProd.Rows(selectedRow).Cells(1, "R").Value = cell.Offset(0, 13).Value
                wsProd.Rows(selectedRow).Cells(1, "S").Value = cell.Offset(0, 14).Value
                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
    
    ' ... [Rest of your data saving logic goes here - it's fine] ...
    ' I am skipping the repetitive copy/paste lines for brevity, assume they are here.
    ' Just ensure you use wsProd.Rows(selectedRow) and wsBkg.Rows(Highest_Version_Row)
    
    ' Example of one line fixed to use variables:
    Set first_DB_avail_row = wsBkg.Range("C7506").End(xlUp).Offset(1, 0)
    first_DB_avail_row.Offset(0, -1).Value = wsProd.Cells(selectedRow, "B").Value
    first_DB_avail_row.Value = wsProd.Cells(selectedRow, "C").Value
    ' ... etc ...
    
    'Set version list:
    ver_list.Add newVersionString
    For Each cell In rng
        If cell.Value = productID_To_Find Then
            ver_list.Add cell.Offset(0, -2).Value
        End If
    Next cell

    'Sort versions:
    For i = 0 To ver_list.Count - 1
        v = ver_list(i)
        If Len(v) > 1 And IsNumeric(Mid(v, 2, 1)) Then 'Basic check
            leadChar = Left(v, 1)
            parts = Split(Mid(v, 2), ".")
            If UBound(parts) = 2 Then
                padded_v = leadChar & Right("000" & parts(0), 3) & Right("000" & parts(1), 3) & Right("000" & parts(2), 3)
                ver_list(i) = padded_v & "|" & v
            End If
        End If
    Next i

    ver_list.Sort: ver_list.Reverse
    For i = 0 To ver_list.Count - 1
        If InStr(ver_list(i), "|") > 0 Then ver_list(i) = Split(ver_list(i), "|")(1)
    Next i
    
    all_vers = "," & Join(ver_list.ToArray, ",")
    
    With wsProd.Cells(selectedRow, "C").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=all_vers
        .IgnoreBlank = True: .InCellDropdown = True
        .ShowInput = False: .ShowError = False
    End With
    
    wsProd.Protect Password:=wsBkg.Range("CY39").Value

    ' --- FINALIZATION ---
    Sheet2.UPDATE_DB_FORCE = True
    ' Use the specific cell, not Selection
    Application.Run "Sheet2.Worksheet_Change", wsProd.Cells(selectedRow, "C")
    Sheet2.UPDATE_DB_FORCE = False
    
    MsgBox "Saved!", vbInformation
    Unload Me

' ---------------------------------------------------------
' CLEANUP SECTION - The Gatekeeper
' ---------------------------------------------------------
MEM_CLEAN:
    ' *** THE MAGIC: Only restore if we actually locked it ***
    If appLocked Then
        On Error Resume Next 'Ignore errors during restore (e.g. user closing Excel)
        Application.Calculation = xlCalculationAutomatic
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        ActiveWorkbook.UpdateRemoteReferences = True
        Application.DisplayStatusBar = True
        Application.DisplayAlerts = True
        On Error GoTo 0
    End If
    
    ' Always try to kill the wait form
    On Error Resume Next
    Unload PLZ_WAIT
    On Error GoTo 0
    
    ' Release memory
    Set rng = Nothing: Set cell = Nothing
    Set first_DB_avail_row = Nothing
    If Not ver_list Is Nothing Then ver_list.Clear: Set ver_list = Nothing
    Set wsProd = Nothing: Set wsBkg = Nothing
    Exit Sub

' ---------------------------------------------------------
' ERROR HANDLER
' ---------------------------------------------------------
ErrorHandler:
    MsgBox "An error occurred in the logic: " & Err.Description, vbCritical
    ' Jump to cleanup to restore settings safely
    Resume MEM_CLEAN
End Sub