Hannah
Hannah

Reputation: 21

Split a cell into multiple rows based on line break and format data elements

The datasets are small (10-25 lines), but I have to run a lot of them and it's getting to be a waste of time.

The original data looks like this:
enter image description here

The output needs to look like this:
enter image description here

Sub x()

Dim v, vOut(), i As Long, j As Long, k As Long, w

v = Sheet8.Range("A1").CurrentRegion.Value
ReDim vOut(1 To UBound(v, 1) * 10, 1 To 2)
For i = LBound(v, 1) To UBound(v, 1)
    w = Split(v(i, 2), Chr(10))    
    For j = LBound(w) To UBound(w)
        k = k + 1
        vOut(k, 1) = v(i, 1)
        vOut(k, 2) = w(j)
    Next j
Next i

Sheet9.Range("A1").Resize(k, 2) = vOut

End Sub

I managed to separate the rows.

I'm lost on how to efficiently automate the rest of the formatting. I could do it through a bunch of Splits but feel there's probably a better way.

Upvotes: 0

Views: 209

Answers (1)

Hannah
Hannah

Reputation: 21

Messy, but eventually figured it out:

Sub VisitInfo()

Dim v, vOut(), i As Long, j As Long, k As Long, w, z

v = Sheet8.Range("A1").CurrentRegion.Value
ReDim vOut(1 To UBound(v, 1) * 10, 1 To 4)
For i = LBound(v, 1) To UBound(v, 1)
    w = Split(v(i, 2), Chr(10))
    
    
    For j = LBound(w) To UBound(w)
        k = k + 1
        vOut(k, 1) = v(i, 1)
        z = Split(w(j), "]")
        a = Split(w(j), "] ")
        c = Split(a(1), " o")
        b = Split(w(j), "=")
        vOut(k, 2) = (z(0) + "]")
        vOut(k, 3) = (c(0))
        vOut(k, 4) = LTrim(b(1))
        
    Next j
Next i

Sheet3.Range("A2").Resize(k, 4) = vOut

End Sub

Upvotes: 1

Related Questions