An Excel Transpose between 2 specific symbols

Question

I'm trying to organize catalog records exported from a very outdated program my library is using to get it ready to import into the new catalog. The records come out like this:

~#[K11

title[Yada Yada

date[19xx

Entry body text

Entry body text

Volume:1

Location: Outer Mongolia

]

And I'd like them to look like this all on one line transposed:

~#[K11 title[Yada Yada date[19xx Entry body text Entry body text Volume:1 Location: Outer Mongolia ]

The records may or may not have all fields, but they all start with '#[' and they all end with ']'. Since these are the only times these symbols show up I was trying to write a macro that would go down column A look for those symbols, and transpose everything between them. But I'm not good enough, any help would be greatly appreciated!

Edit: I am starting from code as answered so nicely by @Excellll in another post and this is where I am so far:

Dim n As Long
n =  30000
For i = 1 To n Step 5
    Range("A1:A5").Offset(i - 1, 0).Select
    Selection.Copy
    Range("B10").Offset((i - 1) / 5 + 1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
Next I

However, each entry is not 5 lines long so I can't use Step 5, also my data is not contiguous so I can't use COUNTA.

Any suggestions for a step of variable size between the two specific characters?

Answer 1

The below macro transforms the input data into the format you’ve specified. Hopefully the remaining records of your dataset will have similar structure else there’s of course room for modifications.
I wasn't quite sure about the ~ sign as it appears in the input but not in your further description. This can be addressed by modifying the startString variable.

Option Explicit

Sub transpose()
Dim i As Long
Dim noOfRows As Long
Dim bc As String 'blank cell replacement
Dim startString As String
Dim endString As String
Dim record As String
Dim j As Long 'where to print record - row number
Const c As Long = 3 'where to print record - column number
Dim sheetname As String
Dim currentCellValue As String
Dim previousCellValue As String 'it is used to ignore multiple consecutive empty cells

startString = "~#["
endString = "]"
bc = " "
j = 1
sheetname = ActiveSheet.Name

'number of rows used in s/s including blanks in between
For i = Worksheets(sheetname).Rows.Count To 1 Step -1
    If Cells(i, 1).Value <> "" Then
        Exit For
    End If
Next i
noOfRows = i

'loop through all rows
For i = 1 To noOfRows
    currentCellValue = Cells(i, 1).Value
    'check if startsWith
    If InStr(Trim(currentCellValue), startString) = 1 Then
        record = currentCellValue
    'check if endsWith
    ElseIf Len(Trim(currentCellValue)) > 0 And Len(Trim(currentCellValue)) = InStrRev(Trim(currentCellValue), endString) Then
        record = record + currentCellValue
        'prints output records to the worksheet
        Cells(j, c).Value = record
        j = j + 1
        Debug.Print record
    ElseIf Len(Trim(currentCellValue)) = 0 And Len(Trim(previousCellValue)) > 0 Then
        record = record + bc
    'non blank cells which are between start and end strings
    ElseIf Len(Trim(currentCellValue)) > 0 Then
        record = record + currentCellValue
    End If
    previousCellValue = currentCellValue
Next i
End Sub