How to transpose a 2D list with repeating objects

RyCar66 0
Viewed 20

I have been trying to write some VBA in Excel to transpose a 2D list, based on searching for the first character "{".

Before: Before

After: enter image description here

My code:

With Sheets("Results").Range(Cell1:="A1", Cell2:="A39")

    Set a = .Find("{", After:=Range("A" & lRow))
    Set b = a
    c = a.Address
    Do While Not .FindNext(b) Is Nothing And a.Address <> .FindNext(b).Address
    
    c = c & "," & .FindNext(b).Address
    rangeToMoveCell1 = a.Address
    rangeToMoveCell2 = .FindNext(b).Address
MsgBox ("rangeToMoveCell1: " & rangeToMoveCell1 & vbNewLine & "rangeToMoveCell2: " & rangeToMoveCell2)
    Sheets("Results").Range(Cell1:=rangeToMoveCell1, Cell2:=rangeToMoveCell2).Copy
    Sheets("Results").Range(Cell1:=rangeToMoveCell1, Cell2:=rangeToMoveCell2).Offset(-3, 1).PasteSpecial Transpose:=True
    Sheets("Results").Range(Cell1:=rangeToMoveCell1, Cell2:=rangeToMoveCell2).Clear
    Set b = .FindNext(b)
    Loop
End With
transpose
1 Answers

I've come up with this and it works, except it does not process the last find:

With Sheets("Results").Range(Cell1:="A1", Cell2:="A" & lRow)

Set a = .Find("{", After:=Range("B" & lRow))
Set b = a
c = a.Offset(3).Address

Do While Not .FindNext(b) Is Nothing And a.Address <> .FindNext(b).Address
    Set nextFind = .FindNext(b)
    Set d = nextFind
    'MsgBox ("d: " & d)
    e = nextFind.Offset(-1, 1).Address
    Sheets("Results").Range(Cell1:=c, Cell2:=e).Copy
    Sheets("Results").Range(Cell1:=c, Cell2:=e).Offset(-3, 2).PasteSpecial Transpose:=True
    Sheets("Results").Range(Cell1:=c, Cell2:=e).EntireRow.Delete
    Sheets("Results").Range(c).EntireRow.Insert
    Sheets("Results").Range(c).EntireRow.Insert
    c = nextFind.Offset(3).Address
    Set b = .FindNext(b)
Loop

End With

RyCar660
Related