Save existing cell-format to a variable

[ElBombay]

Hello Board,

On 11/9/14, I got a typically great response from the board when I asked about "Adding time to a date". The attached code that resulted works but I had to hard-code the formatting for the new value; Excel will default to displaying the full Date & Time string if I don't specify the format. I get a run-time error when I 'Dim cFormat' as a string or a variant; 'Dim .. Date' would defeat the goal of a generic code-block. What an I doing wrong at thline marked with'==>'?

'----------------------------------------------------------------------------
Private Sub cmdChange_Click()
'
'1sr effort with input screens, per link found thru Mr. XL
'Change cell-value per numbers entered, confim in calling preoram
'11/12/14
'
Dim bSubtract As Boolean
Dim cFormat As Variant  'String bombs
Dim iDays As Integer, iHours As Integer, iMins As Integer, iSecs As Integer
Dim dChange As Date, dNew As Date, dOrig As Date

    'Imitialize values
    bSubtract = Me.optSubtract.Value
==>    'cFormat = ActiveCell.Format
    dOrig = ActiveCell.Value
    
    'Move data from form to mVars
    iDays = Me.TxtDays.Value
    iHours = Me.TxtHrs.Value
    iMins = Me.TxtMins.Value
    
    'Convert D/H/M to TDS serial-value, update cell
    iDays = iDays * 1440
    iHours = iHours * 60
    dChange = iDays + iHours + iMins
    If dChange = 0 Then
        Me.TxtDays.SetFocus
        MsgBox "Please enter aleast one nunumber"
        Exit Sub

    ElseIf bSubtract Then
        dChange = dChange * -1
        
    End If
    dChange = dChange / 1440
    dNew = dOrig + dChange
    ActiveCell.Value = dNew
    ActiveCell.NumberFormat = "[$-409]h:mm AM/PM;@"

    Unload Me

End Sub
'----------------------------------------------------------------------------
Private Sub cmdCancel_Click()
  Unload Me

End Sub
'----------------------------------------------------------------------------
Private Sub UserForm_QueryClose(Cancel As Integer, _
  CloseMode As Integer)
  If CloseMode = vbFormControlMenu Then
    Cancel = True
    MsgBox "Please use the button!"
  End If
End Sub
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------

 

[Andrew Poulsom]

The Range object doesn't have a Format property. Maybe you need NumberFormat.

 

[ElBombay]

In my limited understanding of the Object/method/property paradigm, I expected there would be some way to extract the information that can be applied to a cell to begin with. When you say "NumberFormat", is that a term that encompasses all to=he format options, such as Special, Percentage, etc?

 

[Andrew Poulsom]

The NumberFormat property returns or sets one of the formats on the Number tab of the Format Cells dialog.

 

[ElBombay]

Just tested it. Exactly what I was looking for. Thank you

 

[ElBombay]

During regular post-project clean up, I realized that I posted the problematic code that generated this thread but not the resolution that was the result of timely assistance from the board. Hopefully, this will help someone else searching for the simple fix that I missed.

'----------------------------------------------------------------------------
Private Sub cmdChange_Click()
'
'Change cell-value per numbers entered, confim in calling preoram
'11/12/14
'
Dim bSubtract As Boolean
Dim cFormat As String, cNew As String
Dim dChange As Date, dNew As Date, dOrig As Date
Dim iDays As Long, iHours As Integer, iMins As Integer, iSecs As Integer
Dim iError As Integer
On Error GoTo errEditTDS

    'Store cell-values to mVars
    cFormat = ActiveCell.NumberFormat
    dOrig = ActiveCell.Value
    
    'Read data from form into mVars
    bSubtract = Me.optSubtract.Value
    iDays = Me.TxtDays.Value
    iHours = Me.TxtHrs.Value
    iMins = Me.TxtMins.Value
    
    'Convert D/H/M to TDS serial-value, update cell
    iDays = iDays * 1440
    iHours = iHours * 60
    dChange = (iDays + iHours + iMins) / 1440
    If dChange = 0 Then
        Me.TxtDays.SetFocus
        MsgBox "Please enter at least one nunumber"
        GoTo endClickEvent

    ElseIf bSubtract Then
        dChange = dChange * -1
        
    End If
    dNew = dOrig + dChange
    ActiveCell.Value = dNew
    ActiveCell.NumberFormat = cFormat

errEditTDS:
    'Store E.Num to mVar for readability
    iError = Err.Number
    Select Case iError
    Case 1004
        '1900 was not a leap-year so prior calcs can cause confusion
        MsgBox "Date (" & dNew & ") cannot be used for calculations in Excel" & vbCr & vbCrLf _
                & "The 59 days prior to 3/1/1900 will appear to be off by 1 day"
        cNew = dNew
        ActiveCell.Value = cNew
        
    Case Is <> 0                    'Use std system errr-msg
        MsgBox ("Write down Number and Full Message of this Unexpected Error.  Call Jim." _
            & vbCr & vbCrLf & Err.Number & ": " & Err.Description)
        End

    End Select
    On Error GoTo 0
    Unload Me
endClickEvent:
End Sub
'----------------------------------------------------------------------------
Private Sub cmdCancel_Click()
  Unload Me

End Sub
'----------------------------------------------------------------------------
Private Sub UserForm_QueryClose(Cancel As Integer, _
  CloseMode As Integer)
  If CloseMode = vbFormControlMenu Then
    Cancel = True
    MsgBox "Please use the button!"

  End If
End Sub
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------