Text to row VBA codes error in excel - vba

Question

I am using these codes for text to row purpose but i am not able to convert it after certain Number of rows in Col B. whereas it is working fine for col c and d. one more thing if i am removing the on error resume next then i am getting subscript out of range error. please help me on these errors.
Expected Output for given input:
Code:
Sub Main()
On Error Resume Next
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
Columns("C:C").NumberFormat = "#"
For i = 1 To Range("C" & Rows.Count).End(xlUp).Row
v = Split(Range("C" & i), ",")
c = c + UBound(v) + 1
Next i
For i = 2 To c
Set r = Range("C" & i)
arr = Split(r, ",")
r = arr(0)
For j = 1 To UBound(arr)
r.Offset(j, 0) = arr(j)
r.Offset(j, 1) = r.Offset(0, 1)
Next j
Next i
Columns("D:D").NumberFormat = "#"
For i = 1 To Range("D" & Rows.Count).End(xlUp).Row
v = Split(Range("D" & i), ",")
c = c + UBound(v) + 1
Next i
For i = 2 To c
Set r = Range("D" & i)
arr = Split(r, ",")
r = arr(0)
For j = 1 To UBound(arr)
r.Offset(j, 0) = arr(j)
r.Offset(j, 1) = r.Offset(0, 1)
Next j
Next i
Columns("E:E").NumberFormat = "#"
For i = 1 To Range("E" & Rows.Count).End(xlUp).Row
v = Split(Range("E" & i), ",")
c = c + UBound(v) + 1
Next i
For i = 2 To c
Set r = Range("E" & i)
arr = Split(r, ",")
r = arr(0)
For j = 1 To UBound(arr)
r.Offset(j, 0) = arr(j)
r.Offset(j, 1) = r.Offset(0, 1)
Next j
Next i
End Sub

Answer 1

Here is a code that works.
Before:
Inv Hours Bill am Loc
1 10,12 1,2 10,24 BANG,KOL
2 1,2,3 1,2,3 1,4,9 A,B,C
After:
Inv Hours Bill am Loc
1 10 1 10 BANG
1 12 2 24 KOL
2 1 1 1 A
2 2 2 4 B
2 3 3 9 C
Option Explicit
Sub Main()
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
Columns("C:C").NumberFormat = "#"
For i = 1 To Range("C" & Rows.Count).End(xlUp).Row
v = Split(Range("C" & i), ",")
'c = c + UBound(v) + 1
Next i
For i = 2 To c
Set r = Range("C" & i)
arr = Split(r, ",")
r = arr(0)
For j = 1 To UBound(arr)
r.Offset(j, 0) = arr(j)
r.Offset(j, 1) = r.Offset(0, 1)
Next j
Next i
Columns("D:D").NumberFormat = "#"
For i = 1 To Range("D" & Rows.Count).End(xlUp).Row
v = Split(Range("D" & i), ",")
'c = c + UBound(v) + 1
Next i
For i = 2 To c
Set r = Range("D" & i)
arr = Split(r, ",")
r = arr(0)
For j = 1 To UBound(arr)
r.Offset(j, 0) = arr(j)
r.Offset(j, 1) = r.Offset(0, 1)
Next j
Next i
Columns("E:E").NumberFormat = "#"
For i = 1 To Range("E" & Rows.Count).End(xlUp).Row
v = Split(Range("E" & i), ",")
'c = c + UBound(v) + 1
Next i
For i = 2 To c
Set r = Range("E" & i)
arr = Split(r, ",")
r = arr(0)
For j = 1 To UBound(arr)
r.Offset(j, 0) = arr(j)
r.Offset(j, 1) = r.Offset(0, 1)
Next j
Next i
End Sub

Answer 2

So here is a code that works (reposted here as I guess you will close your other question):
Option Explicit
Sub SplitByRows()
Dim Col As Long, LastRow As Long, ColParts() As String
Dim i, a, k As Long
Dim StringNo As String
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To LastRow
k = CountChrInString(Cells(i, 2).Value, ",")
StringNo = Cells(i, 1).Value
For a = 1 To k
Cells(i, 1).Value = Cells(i, 1).Value & "," & StringNo
Next a
Next i
For Col = 1 To 5 'Column A to Column C
ColParts = Split(Join(Application.Transpose(Range(Cells(2, Col), Cells(LastRow, Col))), ","), ",")
With Cells(2, Col).Resize(UBound(ColParts) + 1)
.NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(#_)"
.Value = Application.Transpose(ColParts)
End With
Next
End Sub
Public Function CountChrInString(Expression As String, Character As String) As Long
Dim iResult As Long
Dim sParts() As String
sParts = Split(Expression, Character)
iResult = UBound(sParts, 1)
If (iResult = -1) Then
iResult = 0
End If
CountChrInString = iResult
End Function
All I did was adding some "," to the first column as well at the beginning of your code.
For this I needed to count the amount of "," in the cell of the second column.
This was done with the function from this page: How to find Number of Occurences of Slash from a strings
After that your code just did the rest ;)