Using VBA to separate and stack data from an Excel Cell

Question

I have an excel file where all the data is dumped into 4 cells. Column A has a header and then 4 start times (which will be the same every time) and column B has a header and then 4 cells each of which will contain a different number of email addresses and other details every day so the VBA has to work no matter the density of the cells in column B.

What I want to achieve is neatly stacked rows of data one for each email address no matter the number of addresses in the cell on a given day. The Data is formatted with the row breaks separated by ; and the column breaks separated by , so

[email protected],Jeff Smith,555-4196;[email protected],Bob Jones,555-3827 (all in B2)

needs to become

[email protected] (column break) Jeff Smith (column break) 555-4196

(row break)

[email protected] (column break) Bob Jones (column break) 555-3827

and so on for each cell So far I have tried using inserts with the following code

RowNum1 = (Len(Range("B2")) - Len(Replace(Range("B2"), "@", "")))
RowNum2 = (Len(Range("B3")) - Len(Replace(Range("B3"), "@", "")))
RowNum3 = (Len(Range("B4")) - Len(Replace(Range("B4"), "@", "")))
RowNum4 = (Len(Range("B5")) - Len(Replace(Range("B5"), "@", "")))

If RowNum1 <> 0 Then
Rows("3:" & 1 + RowNum1).EntireRow.Insert
End If

If RowNum2 <> 0 Then
Rows(3 + RowNum1 & ":" & 1 + RowNum1 + RowNum2).EntireRow.Insert
End If

If RowNum3 <> 0 Then
Rows(3 + RowNum1 + RowNum2 & ":" & 2 + RowNum1 + RowNum2 + RowNum3).EntireRow.Insert
End If

and that seems to put the correct row breaks into the data (I'm not 100% on this) but I'm stumped when it comes to separating the data and putting it where it needs to be. Any help would be greatly appreciated.

Try combining the macro recorder and text to columns wizard. This will write the majority of the code for you. — David Rushton
– David Rushton, Commented Jul 28, 2016 at 10:45

user6432984 · Accepted Answer · 2016-07-28 10:10:48Z

2

I didn't bother with the dates. But this will split Range B2 for you.

Sub ExplodeB2()
    Const SampleString = "[email protected],Jeff Smith,555-4196;[email protected],Bob Jones,555-3827 (all in B2)"
    Dim x As Long
    Dim arrRows

    arrRows = Split(Range("B2").Value, ";")

    For x = 0 To UBound(arrRows)

        Cells(x + 2, 2).Resize(1, 3) = Split(arrRows(x), ",")

    Next

End Sub

Before and After

answered Jul 28, 2016 at 10:10

user6432984

Sign up to request clarification or add additional context in comments.

Comments

Slai · Accepted Answer · 2016-07-28 14:56:56Z

0

For multiple cells, you can join the cell values to one string before you split them:

Set rangeFrom = [B2:B5]
Set rangeTo = [D2]

a = WorksheetFunction.Transpose(rangeFrom)  ' from 2D array to 1D array
s = Join(a, ";")
a = Split(s, ";")               ' sorry about my lazy variable names :]

For Each s In a
    v = Split(s, ",")           ' 3 values
    c = UBound(v) + 1           ' UBound(v) is 2
    rangeTo.Resize(, c) = v     ' resize to 3 columns
    Set rangeTo = rangeTo(2)    ' moves to the cell below
Next

answered Jul 28, 2016 at 14:56

Slai

23k5 gold badges49 silver badges55 bronze badges

Collectives™ on Stack Overflow

Using VBA to separate and stack data from an Excel Cell

2 Answers 2

Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related