CODEWITHSUNDEEP
excelvbaformatting
HPS_EHV
HPS_EHV

Reputation: 41

How can I force a NumberFormat on a VBA function result from the VBA function?

Trying to convert timestamps that are given in seconds after Jan first 1970. I have written a small function in Excel VBA to convert to the Excel date format. This works fine in the sense that it converts to a number that if formatted correctly gives the timestamp in an intelligible way, but I have to format the calls by hand each time. I have tried to address the issue in several ways, but either it does not do anything to the number, or it results in an error: "#VALUE." The function is called Sec2TS and if I use: 1502569847 as input it returns: 42959.8547106481, which is correct, but I would like to see: 2017 Aug 12 20:30:47. I have added the code:

   Function Sec2TS(Secs As Double) As Date

If Secs > 0 Then
    Sec2TS = 25569 + (Secs / 86400)
Else
    Sec2TS = 0
End If

ActiveCell.NumberFormat = "yyyy mmm dd hh:mm:ss"

End Function

What is wrong with this? I have tried with set range to selection and toggling application, but to no avail.

Upvotes: 2

Views: 547

Answers (2)

Gary's Student
Gary's Student

Reputation: 96753

If you don't need to process the values numerically, you can use String rather than Date as the function output:

Function Sec2TS(Secs As Double) As String
    Dim D As Double

    If Secs > 0 Then
        D = CStr(25569# + (Secs / 86400#))
    Else
        D = CStr(0)
    End If

    Sec2TS = Format(D, "yyyy mmm dd hh:mm:ss")
End Function

enter image description here

Upvotes: 0

Pᴇʜ
Pᴇʜ

Reputation: 57683

If a formula could change formattings on a sheet, that would result in totally crazy effects for all users, because they would not know why all these odd things actually happen. That is probably the main reason why a formula/UDF cannot change anything in a worksheet, it can only return a value.

As workaround you can use the Worksheet_Change event to format the cell right after you entered a formula that contains Sec2TS. So first we check wich cells of the changed range (Target) contain formulas (Target.SpecialCells(xlCellTypeFormulas)) and then check if any cell in this range contains "Sec2TS" in its formula to .NumberFormat this cells.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim CellsWithFormulas As Range
    On Error Resume Next
    If Target.Cells.CountLarge > 1 Then
        Set CellsWithFormulas = Target.SpecialCells(xlCellTypeFormulas)
    ElseIf Target.HasFormula Then
        Set CellsWithFormulas = Target
    End If
    On Error GoTo 0

    If CellsWithFormulas Is Nothing Then Exit Sub

    Dim Cell As Range
    For Each Cell In CellsWithFormulas.Cells
        If InStr(1, Cell.Formula, "Sec2TS") > 0 Then
            Cell.NumberFormat = "yyyy mmm dd hh:mm:ss"
        End If
    Next Cell
End Sub

Note that the Target.Cells.CountLarge > 1 check is needed because if you apply SpecialCells to only one single cell VBA will apply it automatically to all cells of the worksheet which makes the code very slow.

Upvotes: 1

Related Questions