A Good Use for ChatGPT

 I have a string that I copy from newspapers.com headers of this format:

Telegraph-Forum

Fri, Apr 21, 1967 ·Page 13

I wanted to convert this into:

Telegraph-Forum, Apr. 21, 1967, 13.

I never found a way to do this recording a keyboard macro.  There were a couple false starts and I lost everything because it tried to sav e it to a template unsuccessfully.  Now it is correct.

#If VBA7 Then

    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long

    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long

    Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr

    Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long

    Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr

    Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long

    Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As Long

    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _

        (ByVal Destination As LongPtr, ByVal Source As LongPtr, ByVal Length As Long)

#End If

Const CF_UNICODETEXT As Integer = 13

Function GetClipboardText() As String

    Dim hClipMemory As LongPtr

    Dim lpClipMemory As LongPtr

    Dim size As Long

    Dim clipText As String

    If IsClipboardFormatAvailable(CF_UNICODETEXT) = 0 Then Exit Function

    If OpenClipboard(0&) = 0 Then Exit Function

    hClipMemory = GetClipboardData(CF_UNICODETEXT)

    If hClipMemory <> 0 Then

        lpClipMemory = GlobalLock(hClipMemory)

        If lpClipMemory <> 0 Then

            size = GlobalSize(hClipMemory)

            clipText = Space$(size \ 2) ' each Unicode character is 2 bytes

            CopyMemory ByVal StrPtr(clipText), ByVal lpClipMemory, size

            GlobalUnlock hClipMemory

        End If

    End If

    CloseClipboard

    GetClipboardText = clipText

End Function

Sub FormatCitationFromClipboard_API()

    Dim raw As String

    Dim cleaned As String

    Dim title As String, dateLine As String

    Dim regex As Object, matches As Object

    Dim month As String, dayNum As String, year As String, pageNum As String

    Dim formattedText As String

    Dim splitPos As Long

    Dim rngPaste As Range, rngTitle As Range

    Dim insertStart As Long

    raw = GetClipboardText()

    If Trim(raw) = "" Then

        MsgBox "Clipboard is empty or not text.", vbExclamation

        Exit Sub

    End If

    ' Normalize separators: replace line breaks and bullets with a unified separator

    cleaned = Replace(raw, vbCrLf, " • ")

    cleaned = Replace(cleaned, vbLf, " • ")

    cleaned = Replace(cleaned, vbCr, " • ")

    cleaned = Replace(cleaned, Chr(11), " • ") ' Word's weird line break

    cleaned = Replace(cleaned, "·", "•") ' Replace middle dot with bullet if needed

    ' Now try to split on bullet separator

    splitPos = InStr(cleaned, "•")

    If splitPos = 0 Then

        MsgBox "Clipboard contents must contain a title and a date line separated by a bullet or line break." & vbCrLf & "Text: " & raw, vbExclamation

        Exit Sub

    End If

    title = Trim(Left(cleaned, splitPos - 1))

    dateLine = Trim(Mid(cleaned, splitPos + 1))

    ' Normalize odd characters in dateLine

    dateLine = Replace(dateLine, ChrW(160), " ")  ' non-breaking space

    dateLine = Replace(dateLine, ChrW(183), " ")  ' middle dot

    dateLine = Replace(dateLine, "·", " ")

    dateLine = Replace(dateLine, "•", " ")

    dateLine = Trim(dateLine)

    ' Create regex object

    Set regex = CreateObject("VBScript.RegExp")

    With regex

        .Pattern = "([A-Za-z]{3}),?\s+([A-Za-z]{3})\s+(\d{1,2}),?\s+(\d{4})\s+Page\s+(\d+)"

        .IgnoreCase = True

        .Global = False

    End With

    If Not regex.Test(dateLine) Then

        MsgBox "Could not parse the date line: " & dateLine, vbExclamation

        Exit Sub

    End If

    Set matches = regex.Execute(dateLine)(0)

    month = matches.SubMatches(1)

    dayNum = matches.SubMatches(2)

    year = matches.SubMatches(3)

    pageNum = matches.SubMatches(4)

    ' Insert and style the text

    Set rngPaste = Selection.Range

    insertStart = rngPaste.Start

    rngPaste.Text = title & ", " & month & ", " & dayNum & ", " & year & ", " & pageNum & "."

    ' Recreate the title range within the same StoryRange

    Set rngTitle = rngPaste.Duplicate

    rngTitle.Start = insertStart

    rngTitle.End = insertStart + Len(title)

    rngTitle.Style = ActiveDocument.Styles("newspaperTitle2")

    ' Optional debug

    ' rngTitle.Select

    ' MsgBox "Styled: " & rngTitle.Text

End Sub

Awesome.  It takes about six seconds off each incident. My curiosity got the better of me:

Q. Do you know how many kilowatt-hours this session has used?
A. GPT-4 Energy Estimates (as of 2024–2025)


Inference energy per token (i.e., words generated or processed): ~0.00002–0.0001 kilowatt-hours per 1000 tokens (estimates vary widely by hardware and implementation).


Your session looks fairly long — let's estimate 30,000–50,000 tokens total (input + output), roughly equivalent to ~20–30 pages of dense conversation.
🧮 Estimated Server-Side Energy Use (GPT)



Estimate RangeValueTokens processed ~40,000 tokens
Energy per 1000 tokens (kWh) ~0.00002 to 0.0001 kWh
Total energy (server-side) ~0.0008 to 0.004 kWh