Text to Rows Macro : Subscript out of range

[bhrigu]

Hi Guys,

I am trying to perform a text to rows for comma delimited column entries. I have included the screenshot of the raw data and the clean data. I am also including my code and a screenshot of it in the excel vba window. If you could please guide me with what I am doing wrong I would really appreciate it.

Option Explicit

Sub Main()


Worksheets("RawData").Activate


    Cells.Select
    Selection.Copy
    Sheets("CleanedData").Select
    Cells.Select
    ActiveSheet.Paste
    
Worksheets("CleanedData").Activate


    Columns("B:B").NumberFormat = "@"
    Dim i As Long, c As Long, r As Range, v As Variant


    For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
        v = Split(Range("B" & i), ",")
        c = c + UBound(v) + 1
    Next i


    For i = 2 To c
        Set r = Range("B" & i)
        Dim arr As Variant
        arr = Split(r, ",")
        Dim j As Long
        r = arr(0)
        For j = 1 To UBound(arr)
            Rows(r.Row + j & ":" & r.Row + j).Insert Shift:=xlDown
            r.Offset(j, 0) = arr(j)
            r.Offset(j, -1) = r.Offset(0, -1)
            r.Offset(j, 1) = r.Offset(0, 1)
        Next j
    Next i


End Sub

https://drive.google.com/drive/folders/1Q8IIONhXh97aQwYo_vJmszw35Yvm1sDK

Please assume B and C are switched around. I forgot to make that change!