Reformat log output

[Dr. Demento]

I have a change log for Personal.xlsb (many thanks to MrExcel gurus!). It works fine, but I'd like to reformat it (see current/desired here).

I'd basically like the output to go from one cell with three pieces of data (author/time/date) to the same data in three separate cells, all on the same line.

If someone can point me in the right direction, I don't mind tinkering; I either A) don't know what to search for or B) am not recognizing code from others that does this. It's Monday somewhere, right??

Thanks y'all!

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' http://www.mrexcel.com/forum/excel-questions/864085-backing-up-personal-xlsb-using-visual-basic-applications.html#post4196704#2 & #14
  
Dim wb As Workbook
  Set wb = Workbooks("Personal.xlsb")
Dim strBakPath As String
Dim fsoFSO
  Set fsoFSO = CreateObject("Scripting.FileSystemObject")
  
  With Application  ' https://msdn.microsoft.com/en-us/library/office/ff835544.aspx
    .ScreenUpdating = False
    .DisplayAlerts = False
    .EnableEvents = False
    .DisplayStatusBar = False
  End With
  
' Builds an on going list of who saved file when.
' Code must go into the "ThisWorkbook" module!
' All data is placed in column "A" adjust width and formats.
' http://www.mrexcel.com/forum/excel-questions/24014-visual-basic-applications-macro-tell-who-last-saved-file-when.html#9

  With wb.Worksheets("Sheet1")
    .Range("A1") = "Change Log: " & wb.Name
    .Range("A2") = "Created by: " & Left(wb.BuiltinDocumentProperties("Author"), _
                      FindNthChar(" ", wb.BuiltinDocumentProperties("Author"), 2) - 1) & chr(10) & _
                   "Created on: " & Format(wb.BuiltinDocumentProperties("Creation Date"), "mm/dd/yyyy" & " || " & "hh:mm")
    .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = _
                  "Last Author: " & Left(wb.BuiltinDocumentProperties("Last Author"), _
                      FindNthChar(" ", wb.BuiltinDocumentProperties("Last Author"), 2) - 1) & chr(10) & _
                  "Last Saved: " & Format(wb.BuiltinDocumentProperties("Last Save Time"), "mm/dd/yyyy" & " || " & "hh:mm")
      .UsedRange.RemoveDuplicates Columns:=Array(1), Header:=xlYes  ' https://msdn.microsoft.com/en-us/library/office/ff193823.aspx
  End With
    
  If Application.StartupPath = "\\AppData\Roaming\Microsoft\Excel\XLSTART" Then
    strBakPath = "\\Documents\References\Computer Hacks\MS Office Hacks\Excel\Personal_xlsb\Archived PERSONAL.XLSB Files\"
  Else
    strBakPath = Application.StartupPath & "\Archive\"
    
    If fsoFSO.FolderExists(strBakPath) Then
      GoTo SaveFile
    Else
      fsoFSO.CreateFolder (strBakPath)
    End If
    
  End If
  
SaveFile:
  With Workbooks("PERSONAL.xlsb")
    .SaveCopyAs strBakPath & "PERSONAL.xlsb" & Format(Now, "_yyyymmdd_hhmm.bak")
    .Save
  End With
  
  With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .EnableEvents = True
    .DisplayStatusBar = True
  End With
  
End Sub

 

[Dr. Demento]

Nevermind; I trial/error'ed it out Unless, someone knows a better way??

  With wb.Worksheets("Sheet1")
    .Range("A1") = "Change Log: " & wb.Name
    .Range("A2") = "Created By"
    .Range("B2") = "Created On"
    .Range("A3") = Left(wb.BuiltinDocumentProperties("Author"), _
                      FindNthChar(" ", wb.BuiltinDocumentProperties("Author"), 2) - 1)
    .Range("B3") = Format(wb.BuiltinDocumentProperties("Creation Date"), "mm/dd/yyyy")
    .Range("C3") = Format(wb.BuiltinDocumentProperties("Creation Date"), "hh:mm")
    .Range("A5") = "Last Author"
    .Range("B5") = "Last Saved"

    .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = Left(wb.BuiltinDocumentProperties("Last Author"), _
                      FindNthChar(" ", wb.BuiltinDocumentProperties("Last Author"), 2) - 1)
    .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = Format(wb.BuiltinDocumentProperties("Last Save Time"), "mm/dd/yyyy")
    .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2) = Format(wb.BuiltinDocumentProperties("Last Save Time"), "hh:mm")
    .UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes ' https://msdn.microsoft.com/en-us/library/office/ff193823.aspx
  End With