Excel 2010 VBA - Split String by Comma, Skip Blank Results - arrays

Question

I am using the following code to chop up a column of comma-separated lists and to return each entry in a new row:
Sub SliceNDice()
'
' Splits the locations cells according to commas and pushes to new rows
' Code courtesy of brettdj (http://stackoverflow.com/questions/8560718/split-comma-separated-entries-to-new-rows)
'
Dim objRegex As Object
Dim x
Dim Y
Dim lngRow As Long
Dim lngCnt As Long
Dim tempArr() As String
Dim strArr
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Pattern = "^\s+(.+?)$"
'Define the range to be analysed
x = Range([a1], Cells(Rows.Count, "c").End(xlUp)).Value2
ReDim Y(1 To 3, 1 To 1000)
For lngRow = 1 To UBound(x, 1)
'Split each string by ","
tempArr = Split(x(lngRow, 3), ",")
For Each strArr In tempArr
lngCnt = lngCnt + 1
'Add another 1000 records to resorted array every 1000 records
If lngCnt Mod 1000 = 0 Then ReDim Preserve Y(1 To 3, 1 To lngCnt + 1000)
Y(1, lngCnt) = x(lngRow, 1)
Y(2, lngCnt) = x(lngRow, 2)
Y(3, lngCnt) = objRegex.Replace(strArr, "$1")
Next
Next lngRow
'Dump the re-ordered range to columns E:G
[e1].Resize(lngCnt, 3).Value2 = Application.Transpose(Y)
End Sub
While this code works perfectly, it has a fatal flaw in that any double-commas in the cells of column C will result in blank cells pushed to the new rows in column G.
Does anyone know how to edit the code so that it does not create new rows with empty cells in column G, but skips them and enters the next rows in their places as if the superfluous commas were never included in column C at all?

Answer 1

Just test for the string length of strArr as the first operation inside the For Each strArr In tempArr loop.
For Each strArr In tempArr
If CBool(Len(strArr)) Then
lngCnt = lngCnt + 1
'Add another 1000 records to resorted array every 1000 records
If lngCnt Mod 1000 = 0 Then ReDim Preserve Y(1 To 3, 1 To lngCnt + 1000)
Y(1, lngCnt) = x(lngRow, 1)
Y(2, lngCnt) = x(lngRow, 2)
Y(3, lngCnt) = objRegex.Replace(strArr, "$1")
End If
Next strArr

Answer 2

You could loop on the occurence of double comma to clean up the input as opposed to fixing the output, here is a working example:
Text in A1: Hello,,World,This,,Is,,,,,,,A,,Test
Sub TestString()
Dim MyString As String
MyString = Range("A1").Text
Do Until Len(MyString) = Len(Replace(MyString, ",,", ","))
MyString = Replace(MyString, ",,", ",")
Loop
MsgBox MyString
End Sub
You would do this just before splitting
If you want it as a function (would be better in your case) do this:
Function FixDoubleComma(MyString As String)
Do Until Len(MyString) = Len(Replace(MyString, ",,", ","))
MyString = Replace(MyString, ",,", ",")
Loop
FixDoubleComma = MyString
End Function
Then replace this in your code:
tempArr = Split(x(lngRow, 3), ",")
With this:
tempArr = Split(FixDoubleComma(x(lngRow, 3)), ",")

Answer 3

I have a little sample that solves blanks everywhere
Sub RemoveBlanks()
Dim mystr As String
Dim arrWithBlanks() As String
Dim arrNoBlanks() As String
Dim i As Integer
mystr = ",tom,jerry, ,,spike,," 'Blanks everywhere (beginning, middle and end)
arrWithBlanks = Split(mystr, ",")
ReDim arrNoBlanks(0 To 0)
Debug.Print "Array with blanks:"
'Loop through the array with blanks
For i = LBound(arrWithBlanks) To UBound(arrWithBlanks)
'Check if there is a blank (or element with spaces only)
If Trim(arrWithBlanks(i)) = "" Then
Debug.Print i & " (blank)"
Else
Debug.Print i & " " & arrWithBlanks(i)
If arrNoBlanks(UBound(arrNoBlanks)) <> "" Then ReDim Preserve arrNoBlanks(0 To UBound(arrNoBlanks) + 1)
arrNoBlanks(UBound(arrNoBlanks)) = arrWithBlanks(i)
End If
Next i
Debug.Print "Array with NO blanks:"
For i = LBound(arrNoBlanks) To UBound(arrNoBlanks)
Debug.Print i & " " & arrNoBlanks(i)
Next i
End Sub
Everything will be displayed in the immediate window (Press Ctrl + G to show it)
The result will look like this:
Array with blanks:
0 (blank)
1 tom
2 jerry
3 (blank)
4 (blank)
5 spike
6 (blank)
7 (blank)
Array with NO blanks:
0 tom
1 jerry
2 spike