Currently Excel doesn't have a formula that can reverse the order of an array. However here is the most basic way this can be done:
=LET(t,SUBSTITUTE(SUBSTITUTE(A2,CHAR(13),""),CHAR(10),"|"),n,LEN(t)-LEN(SUBSTITUTE(t,"|",""))+1,arr,TEXTSPLIT(t,"|"),TEXTJOIN(CHAR(10),TRUE,INDEX(arr,SEQUENCE(n,,n,-1))))
This is useful in situations where someone has put all the comments in chronological order in a cell, but you need a quick way to reverse these so you can see the most recent comment at the top.
Here's a macro that does the following:
1. Ask the user to select the source cells (if cells are already selected then autopopulate the question with the selected cells).
2. Ask the user to select the destination cells and whether to reverse the strings.
3. Create an excel VBA macro that will go through the selected cells.
4. For each cell, split it by carriage returns (char(13) or char(10)).
5. For each string, check if the start looks like a date (including all sort of human kind of formats including where it is missing the year, or if a month is written in text form, or dashes and slashes are used). If it is a date then change that text to YYYY-MM-DD format.
6. If it's not a date then add a carriage return at the start and move it to the end of the previous string (so it starts on a new line, but is still considered part of the previous string).
7. Reverse the order of all of the strings in the cell so the first is last, second is second last, etc.
8. Concatenate all the strings with char(10).
9. Repeat for the next cell until all cells are done.
10. Return the strings for each cell in the destination cells.
Option Explicit
' === User-tunable settings ===
Private Const AMBIGUOUS_NUMERIC_ORDER As String = "DMY" ' "DMY" (AU/UK) or "MDY" (US)
Private Const DEFAULT_MISSING_YEAR As Long = -1 ' -1 = use current year; or set a fixed year, e.g., 2026
Public Sub Transform_GroupReverseAndNormalizeDates()
On Error GoTo CleanFail
Dim src As Range, dstInput As Range, dst As Range
Dim defaultSrcAddr As String
Dim doReverse As Boolean
' Keep UI responsive for range selection prompts
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
' Suggest current selection as default source
If Not Selection Is Nothing Then
If TypeName(Selection) = "Range" Then
defaultSrcAddr = Selection.Address(False, False)
End If
End If
' 1) Ask user to select source (autopopulates with selection if any)
Set src = PromptForRange( _
"Select the **SOURCE** cells to process." & vbCrLf & _
"Tip: The current selection is pre-filled if available.", _
"Select Source Range", _
defaultSrcAddr)
If src Is Nothing Then GoTo CleanExit
' 2) Ask user to select destination (single top-left cell or exact-size range)
Set dstInput = PromptForRange( _
"Select the **DESTINATION** cell(s)." & vbCrLf & _
"Select a single top-left cell OR a range of the same size as the source.", _
"Select Destination Range", _
"")
If dstInput Is Nothing Then GoTo CleanExit
If dstInput.Cells.count = 1 Then
Set dst = dstInput.Resize(src.Rows.count, src.Columns.count)
Else
If dstInput.Rows.count <> src.Rows.count Or dstInput.Columns.count <> src.Columns.count Then
MsgBox "Destination range does not match the source size. " & vbCrLf & _
"Source: " & src.Rows.count & "x" & src.Columns.count & vbCrLf & _
"Destination: " & dstInput.Rows.count & "x" & dstInput.Columns.count, vbExclamation
GoTo CleanExit
End If
Set dst = dstInput
End If
' 3) Ask whether to reverse the groups/comments order
Dim reverseAns As VbMsgBoxResult
reverseAns = MsgBox("Reverse the groups/comments order?" & vbCrLf & _
"(Yes = reverse; No = keep original order)", _
vbYesNo + vbQuestion, "Reverse Order?")
doReverse = (reverseAns = vbYes)
' Now we can optimize for the processing work
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.StatusBar = "Processing " & (src.Rows.count * src.Columns.count) & " cell(s)..."
' Ensure wrap text so linefeeds show as new lines
dst.WrapText = True
Dim r As Long, c As Long
Dim s As String, processed As String
For r = 1 To src.Rows.count
For c = 1 To src.Columns.count
s = CStr(src.Cells(r, c).Value2)
processed = ProcessCellText_GroupAndReverse(s, doReverse)
dst.Cells(r, c).value = processed
Next c
Next r
Application.StatusBar = False
GoTo CleanExit
CleanFail:
Application.StatusBar = False
MsgBox "An error occurred: " & Err.Number & " - " & Err.Description, vbCritical
CleanExit:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
' ==== Normalize, group non-date lines under previous date line, optional reverse, join with LF ====
Private Function ProcessCellText_GroupAndReverse(ByVal inputText As String, ByVal doReverse As Boolean) As String
Dim norm As String: norm = NormalizeNewlines(inputText)
Dim parts() As String
parts = Split(norm, vbLf)
Dim groups() As String
Dim gCount As Long: gCount = 0
Dim i As Long
For i = LBound(parts) To UBound(parts)
Dim lineText As String: lineText = parts(i)
Dim formattedLine As String
If HasAndFormatLeadingDate(lineText, formattedLine) Then
' Starts with a date ? start a new group with date normalized to YYYY-MM-DD:
AppendGroup groups, gCount, formattedLine
Else
' Not a date ? append to previous group with a leading LF
If gCount = 0 Then
' No previous group exists; start a new one with the raw line
AppendGroup groups, gCount, lineText
Else
groups(gCount - 1) = groups(gCount - 1) & vbLf & lineText
End If
End If
Next i
' Optional: reverse the groups (first becomes last, etc.)
If doReverse And gCount > 1 Then
Dim a As Long, b As Long
Dim tmp As String
a = 0: b = gCount - 1
Do While a < b
tmp = groups(a)
groups(a) = groups(b)
groups(b) = tmp
a = a + 1
b = b - 1
Loop
End If
' Join with LF (CHAR(10))
If gCount = 0 Then
ProcessCellText_GroupAndReverse = ""
Else
ProcessCellText_GroupAndReverse = Join(groups, vbLf)
End If
End Function
' ==== Append helper for dynamic string array ====
Private Sub AppendGroup(ByRef arr() As String, ByRef count As Long, ByVal value As String)
If count = 0 Then
ReDim arr(0 To 0)
arr(0) = value
count = 1
Else
ReDim Preserve arr(0 To count)
arr(count) = value
count = count + 1
End If
End Sub
' ==== Normalize all forms of newlines to LF ====
Private Function NormalizeNewlines(ByVal s As String) As String
If LenB(s) = 0 Then
NormalizeNewlines = s
Exit Function
End If
s = Replace(s, vbCrLf, vbLf)
s = Replace(s, vbCr, vbLf)
NormalizeNewlines = s
End Function
' ==== Ask user for a range with Application.InputBox(Type:=8) ====
Private Function PromptForRange(ByVal prompt As String, ByVal title As String, ByVal defaultAddr As String) As Range
On Error GoTo Cancelled
Dim resp As Variant
' Ensure UI is available for range selection
Dim prevSU As Boolean: prevSU = Application.ScreenUpdating
Application.ScreenUpdating = True
If Len(defaultAddr) > 0 Then
Set resp = Application.InputBox(prompt:=prompt, title:=title, Default:=defaultAddr, Type:=8)
Else
Set resp = Application.InputBox(prompt:=prompt, title:=title, Type:=8)
End If
Application.ScreenUpdating = prevSU
Set PromptForRange = resp
Exit Function
Cancelled:
Application.ScreenUpdating = True
Set PromptForRange = Nothing
End Function
' ==== Detect and format a leading date; returns True if a date is found ====
Private Function HasAndFormatLeadingDate(ByVal lineText As String, ByRef formattedLine As String) As Boolean
Dim prefixSpaces As String, rest As String
Dim i As Long, ch As String
' Preserve leading spaces/tabs
i = 1
Do While i <= Len(lineText)
ch = Mid$(lineText, i, 1)
If ch = " " Or ch = vbTab Then
i = i + 1
Else
Exit Do
End If
Loop
prefixSpaces = Left$(lineText, i - 1)
rest = Mid$(lineText, i)
If Len(rest) = 0 Then
formattedLine = lineText
HasAndFormatLeadingDate = False
Exit Function
End If
Dim matchedLen As Long
Dim yyyyMmDd As String
If TryMatchLeadingDate(rest, yyyyMmDd, matchedLen) Then
formattedLine = prefixSpaces & yyyyMmDd & Mid$(rest, matchedLen + 1)
HasAndFormatLeadingDate = True
Else
formattedLine = lineText
HasAndFormatLeadingDate = False
End If
End Function
' ==== Try multiple human date formats at the start ====
Private Function TryMatchLeadingDate(ByVal text As String, ByRef yyyyMmDd As String, ByRef matchedLen As Long) As Boolean
On Error GoTo Fail
Dim re As Object, m As Object, d As Date
Set re = CreateObject("VBScript.RegExp")
re.Global = False
re.IgnoreCase = True
re.Multiline = False
Dim mm As Long, dd As Long, yr As Long
Dim curYear As Long
curYear = Year(Date)
If DEFAULT_MISSING_YEAR <> -1 Then curYear = DEFAULT_MISSING_YEAR
Dim ok As Boolean
' 1) YYYY-MM-DD / YYYY/MM/DD / YYYY.MM.DD
re.Pattern = "^\s*(\d{4})\/\.\-\/\.\-"
Set m = re.Execute(text)
If m.count > 0 Then
yr = CLng(m(0).SubMatches(0))
mm = CLng(m(0).SubMatches(1))
dd = CLng(m(0).SubMatches(2))
ok = SafeDateSerial(yr, mm, dd, d)
If ok Then
yyyyMmDd = Format$(d, "yyyy-mm-dd") & ":"
matchedLen = m(0).Length
TryMatchLeadingDate = True
Exit Function
End If
End If
' 2) D/M/Y (DMY or MDY), supports -, /, . with 1–2 digit day/month, 2–4 digit year
re.Pattern = "^\s*(\d{1,2})\/\.\-\/\.\-"
Set m = re.Execute(text)
If m.count > 0 Then
Dim a As Long, b As Long, y As Long
a = CLng(m(0).SubMatches(0))
b = CLng(m(0).SubMatches(1))
y = CLng(m(0).SubMatches(2))
yr = NormalizeYear(y)
If UCase$(AMBIGUOUS_NUMERIC_ORDER) = "MDY" Then
mm = a: dd = b
Else
dd = a: mm = b
End If
ok = SafeDateSerial(yr, mm, dd, d)
If ok Then
yyyyMmDd = Format$(d, "yyyy-mm-dd") & ":"
matchedLen = m(0).Length
TryMatchLeadingDate = True
Exit Function
End If
End If
' 3) D/M (no year) ? assume current (or DEFAULT_MISSING_YEAR)
re.Pattern = "^\s*(\d{1,2})\/\.\-(?!\s*[\/\.\-]\s*\d)"
Set m = re.Execute(text)
If m.count > 0 Then
dd = CLng(m(0).SubMatches(0))
mm = CLng(m(0).SubMatches(1))
If UCase$(AMBIGUOUS_NUMERIC_ORDER) = "MDY" Then
Dim tmp As Long: tmp = dd: dd = mm: mm = tmp
End If
yr = curYear
ok = SafeDateSerial(yr, mm, dd, d)
If ok Then
yyyyMmDd = Format$(d, "yyyy-mm-dd") & ":"
matchedLen = m(0).Length
TryMatchLeadingDate = True
Exit Function
End If
End If
' 4) MonthName D, Y e.g., January 3, 2024 / Jan 3, 24 / Jan 3
re.Pattern = "^\s*([A-Za-z]{3,}\.?)\s+(\d{1,2})(?:st|nd|rd|th)?(?:,\s*(\d{2,4}))?"
Set m = re.Execute(text)
If m.count > 0 Then
mm = MonthTextToNumber(CStr(m(0).SubMatches(0)))
dd = CLng(m(0).SubMatches(1))
If LenB(m(0).SubMatches(2)) > 0 Then
yr = NormalizeYear(CLng(m(0).SubMatches(2)))
Else
yr = curYear
End If
ok = SafeDateSerial(yr, mm, dd, d)
If ok Then
yyyyMmDd = Format$(d, "yyyy-mm-dd") & ":"
matchedLen = m(0).Length
TryMatchLeadingDate = True
Exit Function
End If
End If
' 5) D MonthName Y e.g., 3 January 2024 / 3 Jan / 3rd Jan 24
re.Pattern = "^\s*(\d{1,2})(?:st|nd|rd|th)?\s+([A-Za-z]{3,}\.?)(?:\s+(\d{2,4}))?"
Set m = re.Execute(text)
If m.count > 0 Then
dd = CLng(m(0).SubMatches(0))
mm = MonthTextToNumber(CStr(m(0).SubMatches(1)))
If LenB(m(0).SubMatches(2)) > 0 Then
yr = NormalizeYear(CLng(m(0).SubMatches(2)))
Else
yr = curYear
End If
ok = SafeDateSerial(yr, mm, dd, d)
If ok Then
yyyyMmDd = Format$(d, "yyyy-mm-dd") & ":"
matchedLen = m(0).Length
TryMatchLeadingDate = True
Exit Function
End If
End If
' 6) ISO compact at start: YYYYMMDD
re.Pattern = "^\s*(\d{4})(\d{2})(\d{2})"
Set m = re.Execute(text)
If m.count > 0 Then
yr = CLng(m(0).SubMatches(0))
mm = CLng(m(0).SubMatches(1))
dd = CLng(m(0).SubMatches(2))
ok = SafeDateSerial(yr, mm, dd, d)
If ok Then
yyyyMmDd = Format$(d, "yyyy-mm-dd") & ":"
matchedLen = m(0).Length
TryMatchLeadingDate = True
Exit Function
End If
End If
TryMatchLeadingDate = False
Exit Function
Fail:
TryMatchLeadingDate = False
End Function
' ==== Convert month text to month number ====
Private Function MonthTextToNumber(ByVal monthText As String) As Long
Dim s As String
s = LCase$(Trim$(monthText))
If Right$(s, 1) = "." Then s = Left$(s, Len(s) - 1)
If Len(s) >= 3 Then s = Left$(s, 3)
Select Case s
Case "jan": MonthTextToNumber = 1
Case "feb": MonthTextToNumber = 2
Case "mar": MonthTextToNumber = 3
Case "apr": MonthTextToNumber = 4
Case "may": MonthTextToNumber = 5
Case "jun": MonthTextToNumber = 6
Case "jul": MonthTextToNumber = 7
Case "aug": MonthTextToNumber = 8
Case "sep": MonthTextToNumber = 9
Case "oct": MonthTextToNumber = 10
Case "nov": MonthTextToNumber = 11
Case "dec": MonthTextToNumber = 12
Case Else: MonthTextToNumber = 0
End Select
End Function
' ==== Normalize 2-digit year to 4-digit (windowing rule: 00–29 => 2000–2029, else 1900–1999) ====
Private Function NormalizeYear(ByVal y As Long) As Long
If y < 100 Then
If y <= 29 Then
NormalizeYear = 2000 + y
Else
NormalizeYear = 1900 + y
End If
Else
NormalizeYear = y
End If
End Function
' ==== Safe DateSerial with validation ====
Private Function SafeDateSerial(ByVal y As Long, ByVal m As Long, ByVal d As Long, ByRef result As Date) As Boolean
On Error GoTo Bad
If y < 100 Or y > 9999 Then GoTo Bad
If m < 1 Or m > 12 Then GoTo Bad
If d < 1 Or d > 31 Then GoTo Bad
result = DateSerial(y, m, d)
SafeDateSerial = (Year(result) = y And Month(result) = m And Day(result) = d)
Exit Function
Bad:
SafeDateSerial = False
End Function