Hello nobi,
I have added 2 new macro to the attached workbook. The code code for these appears below. This will reverse the data order of each log entry in the cell, bold the date, and add a vertical tab to each log entry. You can easily change where the log entries are located. The worksheet name and starting cell address are located in the macro ReverseAllDates and are marked in red.
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"
'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
Sub ReverseAllDates()
Dim Col As Long
Dim Cell As Range
Dim LastRow As Long
Dim Rng As Range
Dim StartCell As Range
Dim StartRow As Long
Dim Wks As Worksheet
Set Wks = Worksheets("Intl Report CR")
Set StartCell = Wks.Range("H2")
With Wks
Col = StartCell.Column
StartRow = StartCell.Row
LastRow = .Cells(Rows.Count, StartCell.Column).End(xlUp).Row
LastRow = IIf(LastRow < StartRow, StartRow, LastRow)
Set Rng = .Range(.Cells(StartRow, Col), .Cells(LastRow, Col))
End With
For Each Cell In Rng
ReverseDates2 Cell
Next Cell
End Sub
Sincerely,
Leith Ross
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks