How to make dynamic column range for splitting string on comma - excel

Question

I'm trying to create a macro that will go into a workbook, find cells that have a comma in them, split them and paste them starting at the last row in that column. The code below somewhat works but
It's limited in terms of changing the column range every time (a,b,c,etc). How do I dynamic, meaning run on multiple columns regardless of wherever the data starts?
Only start after the first row since I have headers.
The actual code below is a bit slow, what can I do to have it run more efficiently?
Sub LoopRange()
Dim rCell As Range
Dim rRng As Range
Dim myarray As Variant
Set rRng = Sheet1.Range("A:A")
For Each rCell In rRng
If InStr(1, rCell, ",") > 0 Then
myarray = Split(rCell, ",")
For i = 0 To UBound(myarray)
Range("A" & Rows.Count).End(xlUp).Offset(1).Value = myarray(i)
Next
Else
End If
Next
End Sub

Answer 1

Split Cell Values
Option Explicit
Sub GetSplitsTEST()
' The number of empty rows between the source (initial) data
' and the destination (resulting) data.
Const EmptyRows As Long = 0
Const Delimiter As String = ","
' Create a reference to the range.
Dim rg As Range
With Sheet1.Range("A1").CurrentRegion
'Debug.Print .Address ' with headers
Set rg = .Resize(.Rows.Count - 1).Offset(1)
'Debug.Print rg.Address ' without headers
End With
' Use the 'GetSplits' function to get the result in an array.
Dim Data As Variant: Data = GetSplits(rg, Delimiter)
' Validate the array.
If Not IsEmpty(Data) Then
' Write the result below the range.
rg.Cells(1).Offset(rg.Rows.Count + EmptyRows) _
.Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data
End If
End Sub
Function GetSplits( _
ByVal rg As Range, _
Optional ByVal Delimiter As String = ",") _
As Variant
If rg Is Nothing Then Exit Function
Dim rCount As Long: rCount = rg.Rows.Count
Dim cCount As Long: cCount = rg.Columns.Count
Dim sData As Variant
If rCount = 1 And cCount = 1 Then
ReDim sData(1 To 1, 1 To 1): sData(1, 1) = rg.Value
Else
sData = rg.Value
End If
Dim cDat As Variant: ReDim cDat(1 To cCount, 1 To 3)
Dim rDat As Variant: ReDim rDat(1 To rCount)
Dim c As Long, sr As Long, n As Long, drCount As Long, maxCount As Long
For c = 1 To cCount
drCount = 0
cDat(c, 1) = rDat
cDat(c, 2) = rDat
n = 0
For sr = 1 To rCount
If InStr(1, sData(sr, c), Delimiter) > 0 Then
n = n + 1
cDat(c, 1)(n) = Split(sData(sr, c), Delimiter)
cDat(c, 2)(n) = UBound(cDat(c, 1)(n))
drCount = drCount + cDat(c, 2)(n) + 1
End If
Next sr
cDat(c, 3) = n
If drCount > maxCount Then
maxCount = drCount
End If
Next c
Dim dData As Variant: ReDim dData(1 To maxCount, 1 To cCount)
Dim dr As Long
For c = 1 To cCount
dr = 0
For n = 1 To cDat(c, 3)
For sr = 0 To cDat(c, 2)(n)
dr = dr + 1
dData(dr, c) = cDat(c, 1)(n)(sr)
Next sr
Next n
Next c
GetSplits = dData
End Function