Excel, VBA split a cell value into multiple rows

Question

I am trying to automate some pieces of information in Excel.

I need the value in Column A to be divided equally by the number of “Line of business” (Column E), and display each "Line of business" on a separate row.

Is it possible and how to do it?

Input:

Amount   summary_type   Application         Cost Source   Line of Business
0,6      Employee       eDrive Monitoring   eDrive        R&D; APAC; Group IT;

Expected result:

Amount   summary_type   Application         Cost Source   Line of Business
0,2      Employee       eDrive Monitoring   eDrive        R&D;
0,2      Employee       eDrive Monitoring   eDrive        APAC;
0,2      Employee       eDrive Monitoring   eDrive        Group IT;

score 1 · Answer 1 · edited Aug 29 '17 at 10:55

Assuming you have all of the jobs in "Line of Business" ending with a colon then it is possible with the following code:

Remember, there is no undo so take a back up first.

Public Sub SortRecords()

Dim intENDROW As Integer
Dim intCOUNTER As Integer
Dim intCOUNTER2 As Integer
Dim intSTRINGLENGTH As Integer
Dim intNUMBERCOLON As Integer
Dim intSTARTROW As Integer
Dim currDIVIDED As Currency
Dim intSTART As Integer
Dim intPOS As Integer

intENDROW = Range("A65536").End(xlUp).Row  'Get last row containing data
intSTARTROW = intENDROW + 3

' Re-populate headers
Range("A" & intENDROW + 2).Value = Range("A1").Text
Range("B" & intENDROW + 2).Value = Range("B1").Text
Range("C" & intENDROW + 2).Value = Range("C1").Text
Range("D" & intENDROW + 2).Value = Range("D1").Text
Range("E" & intENDROW + 2).Value = Range("E1").Text

For intCOUNTER = 2 To intENDROW
    intNUMBERCOLON = 0
    intSTART = 1
    intSTRINGLENGTH = Len(Range("E" & intCOUNTER).Text) ' Get length of string containing "Line of Business"
    For intCOUNTER2 = 1 To intSTRINGLENGTH
        If Mid(Range("E" & intCOUNTER).Text, intCOUNTER2, 1) = ";" Then intNUMBERCOLON = intNUMBERCOLON + 1 ' Count how many colons are in this line
    Next

    If intNUMBERCOLON > 0 Then
        currDIVIDED = Range("A" & intCOUNTER).Value / intNUMBERCOLON ' Get average value of Amount column

        For intCOUNTER2 = 1 To intNUMBERCOLON
            intPOS = InStr(intSTART, Range("E" & intCOUNTER).Text, ";", vbTextCompare)  ' Find each instance of a colon
            Range("E" & intSTARTROW + intCOUNTER2 - 1).Value = Mid(Range("E" & intCOUNTER).Text, intSTART, intPOS - intSTART + 1) ' Copy text before colon to new line
            intSTART = intPOS + 2 ' Update start search position
        Next

        For intCOUNTER2 = intSTARTROW To (intNUMBERCOLON + intSTARTROW - 1)
            Range("A" & intCOUNTER2).Value = currDIVIDED
            Range("B" & intCOUNTER2).Value = Range("B" & intCOUNTER).Text
            Range("C" & intCOUNTER2).Value = Range("C" & intCOUNTER).Text
            Range("D" & intCOUNTER2).Value = Range("D" & intCOUNTER).Text

        Next
        intSTARTROW = intSTARTROW + intNUMBERCOLON
    End If
Next

Range("A1", "A65536").NumberFormat = "General" ' Restore Amount column to a standard number

End Sub

And this will give you from this:

To this:

I've deliberately put the cut data on the same sheet so you can check it before you copy and paste it.

How do I add VBA in MS Office?

Excel, VBA split a cell value into multiple rows

1 Answers1