Code:
Sub MoreFightingWithDates() ' https://eileenslounge.com/viewtopic.php?p=325516#p325516
Dim Ws2 As Worksheet, Rng As Range: Set Ws2 = Sheet2: Ws2.Activate
' Ws2.Range("B1:B20").Insert Shift:=xlToRight, CopyOrigin:=xlLeft ' https://www.excelfox.com/forum/showthread.php/2221-VBA-Range-Insert-Method-Code-line-makes-a-space-to-put-new-range-in
Rem 0 I routinely check what sShortDate in registry before doing any date experiments.
Let Ws2.Range("B1") = Pubics.GetMySystemsShortDate ' dd.MM.yyyy
Rem 1 Safe - Start with a defined underlining cell type, and use = DateSerial(Year:=2025, Month:=2, Day:=28)
Ws2.Range("B2").Clear
Let Ws2.Range("B2").NumberFormat = "m/d/yyyy": Let Ws2.Range("B2").Interior.ColorIndex = 20
Let Ws2.Range("B2") = DateSerial(Year:=2025, Month:=2, Day:=28)
Rem 2 Look in variables after they are given an unambiguous date
Dim vTemp As Variant, dTemp As Date, sTemp As String, lTemp As Long
Let vTemp = DateSerial(Year:=2025, Month:=2, Day:=28) ' 28.02.2025
Debug.Print vTemp
Let dTemp = DateSerial(Year:=2025, Month:=2, Day:=28) ' 28.02.2025
Debug.Print dTemp
Let sTemp = DateSerial(Year:=2025, Month:=2, Day:=28) ' Hmm.... Immediate window 28.02.2025 , Hover "28.02.2025"
Debug.Print sTemp
Let lTemp = DateSerial(Year:=2025, Month:=2, Day:=28) ' 45716
Debug.Print lTemp
'_2b) Put in cells with undelying cell format of Text
Ws2.Range("B3:B7").Clear
Let Ws2.Range("B3:B7").NumberFormat = "@": Let Ws2.Range("B3:B7").Interior.ColorIndex = 15
Let Ws2.Range("B3") = vTemp ' In cell 2/28/2025
Let Ws2.Range("B4") = dTemp ' In cell 2/28/2025
Let Ws2.Range("B5") = sTemp ' In cell 28.02.2025
Let Ws2.Range("B6") = lTemp ' In cell 45716
Let Ws2.Range("B7") = DateSerial(Year:=2025, Month:=2, Day:=28) ' In cell 2/28/2025
'_2c) Put in cells with undelying cell format of General
Ws2.Range("B13:B17").Clear
Let Ws2.Range("B13") = vTemp ' In cell 28.02.2025
Let Ws2.Range("B14") = dTemp ' In cell 28.02.2025
Let Ws2.Range("B15") = sTemp ' In cell 28.02.2025
Let Ws2.Range("B16") = lTemp ' In cell 45716
Let Ws2.Range("B17") = DateSerial(Year:=2025, Month:=2, Day:=28) ' In cell 28.02.2025
'_-
Rem 3 Make a copy of the results to the right, in Text so that it stays as it is, and use normal cell formatting to try and represent close to what it actually looked like
Ws2.Range("C1:C20").Insert Shift:=xlToRight, CopyOrigin:=xlLeft
Let Ws2.Range("C1:C20").NumberFormat = "@"
For Each Rng In Ws2.Range("B1:B17")
If Rng.NumberFormat = "m/d/yyyy" Then
Let Rng.Resize(1, 2).Interior.ColorIndex = 20 ' light blue to indicate underlying Date type
Let Rng.Offset(0, 1).Value2 = Rng.Text
Let Rng.Offset(0, 1).HorizontalAlignment = xlRight
ElseIf Rng.NumberFormat = "@" Then
Let Rng.Resize(1, 2).Interior.ColorIndex = 15 ' light grey to indicate underlying Text type
Let Rng.Offset(0, 1).Value2 = Rng.Text
If Not Rng.Offset(0, 1) = "" And IsNumeric(Rng.Offset(0, 1)) Then Let Rng.Offset(0, 1) = 1 * Rng.Offset(0, 1).Value
Let Rng.Offset(0, 1).HorizontalAlignment = xlLeft
ElseIf Rng.NumberFormat = "General" Then
If IsNumeric(Rng.Value2) And InStr(1, Rng.Value2, ",", vbBinaryCompare) = 0 And InStr(1, Rng.Value2, ".", vbBinaryCompare) = 0 Then ' Text put into a cell is aligned to the left border of the cell while numbers are aligned to the right
Let Rng.Offset(0, 1).Value2 = Rng.Text
If Not Rng.Offset(0, 1) = "" Then Let Rng.Offset(0, 1) = 1 * Rng.Offset(0, 1).Value
Let Rng.Offset(0, 1).HorizontalAlignment = xlRight '
Else
Let Rng.Offset(0, 1).Value2 = Rng.Text
Let Rng.Offset(0, 1).HorizontalAlignment = xlLeft
End If
Else
Let Rng.Offset(0, 1).Value2 = Rng.Text
End If
Next Rng
Stop ' This will help by debuging to hover over or ? Debug.Print in the Ctrl+G Immediate window, as well as causing the VB Editor to open automatically.
End Sub
A Function needed is in the next post
Bookmarks