Reverse Data Within Cell By Date

Hi Leith,

I hope Im not pushing my luck, but do you know if I can restrict (delete) to only show 4 date/user entries. The work long is getting kind of long with all the notes entered, so I wanted to see the 4 most recent entries.

Thanks again!!

Hello nobi,

I have added an If...Then to limit the maximum entries to 4. This will of courser permanently change the data on the sheet. You will lose the other entries above 4 for that cell.

Sub ReverseDates2(ByRef LogCell As Range)

  Dim LenArray() As Integer
  Dim LogArray() As String
  Dim LogData As String
  Dim Matches As Variant
  Dim I As Integer, N As Integer
  Dim RE As Object
  Dim X As Long
  
    Set RE = CreateObject("VBScript.RegExp")
    
      With RE
        .Global = True
        .Pattern = "(\d{2}/){2}\d{4}\s(\d{1,2}:){2}\d{2}\s[AP][M]"
      End With
      
     'Place log entries in a string variable for faster access
      LogData = LogCell.Value
     'Remove all vertical tabs
      LogData = Replace(LogData, vbLf, "")
      
      If RE.Test(LogData) = True Then
         Set Matches = RE.Execute(LogData)
         N = Matches.Count - 1
        'Array holds each log entry
         ReDim LogArray(N)
        'Array holds the character lengths of the date and log entry
         ReDim LenArray(N, 1)
           With Matches
             For I = 0 To N
               If I < N Then
                  LogArray(I) = Mid(LogData, .Item(I).FirstIndex + 1, .Item(I + 1).FirstIndex + 1 - (.Item(I).FirstIndex + 1))
                  LenArray(I, 1) = .Item(I).Length
               End If
             Next I
             LogArray(N) = Mid(LogData, .Item(N).FirstIndex + 1, Len(LogData) - .Item(N).FirstIndex + 1)
             LenArray(N, 1) = .Item(N).Length
          End With
      
       'Reset the cell
        LogCell = ""
        LogCell.Font.FontStyle = "regular"
        
       'Limit the entries to more than 4 per cell
        If N > 4 Then N = 4

       'Load the log entires in reverse and add a vertical tab to each line
        For I = N To 0 Step -1
          LenArray(I, 0) = Len(LogCell) + 1
          LogCell = LogCell & LogArray(I) & vbLf
        Next I
      
       'Bold the entry dates - This extra loop is necessary because the
       'Font Style of the cell is set by the first character. The style is
       're-applied when the cell's characters are concatenated.
        For I = 0 To N
          LogCell.Characters(LenArray(I, 0), LenArray(I, 1)).Font.Bold = True
        Next I
      End If
        
   'Free Object in Memory
    Set RE = Nothing
    
End Sub

Sincerely,
Leith Ross