VBA to split cells

I need help with splitting cell based on delimiter. please see attached file.

i have uploaded a file that shows Before and After.

i need to help with VBA to convert before sheet and create sheet like "AFTER" worksheet.

any help is appreciated.
EE.xlsx
LVL 2
Skylar-BarlowAsked:
Who is Participating?
 
NorieVBA ExpertCommented:
Give this a try.
Sub SplitStuff()
Dim arrIn As Variant
Dim arrOut()
Dim I As Long

    Sheets("BEFORE").Copy After:=Sheets("BEFORE")
    
    ActiveSheet.Name = "AFTER"
    
    With Sheets("AFTER")
    
        arrIn = .Range("A7", .Cells(7, Columns.Count).End(xlToLeft)).Value
    
        ReDim arrOut(1 To 2, 1 To UBound(arrIn, 2))
        
        For I = 1 To UBound(arrIn, 2)
            If InStr(arrIn(1, I), "/") > 0 Then
                arrOut(1, I) = Split(arrIn(1, I), "/")(1)
                
                arrOut(2, I) = Split(arrIn(1, I), "/")(0)
            Else
                arrOut(2, I) = arrIn(1, I)
            End If
        Next I
        
        .Range("A6").Resize(2, UBound(arrOut, 2)).Value = arrOut
        
        .Rows(1).Resize(5).Delete
        
    End With
    
End Sub

Open in new window

2
 
NorieVBA ExpertCommented:
Try this.
Sub SplitStuff()
Dim arrIn As Variant
Dim arrOut()
Dim I As Long

    With Sheets("BEFORE")
        arrIn = .Range("A7", .Cells(7, Columns.Count).End(xlToLeft)).Value
    
        ReDim arrOut(1 To 2, 1 To UBound(arrIn, 2))
        
        For I = 1 To UBound(arrIn, 2)
            If InStr(arrIn(1, I), "/") > 0 Then
                arrOut(1, I) = Split(arrIn(1, I), "/")(1)
                
                arrOut(2, I) = Split(arrIn(1, I), "/")(0)
            Else
                arrOut(2, I) = arrIn(1, I)
            End If
        Next I
        
        .Range("A6").Resize(2, UBound(arrOut, 2)).Value = arrOut
        
        .Rows(1).Resize(5).Delete
        
    End With
    
End Sub

Open in new window

0
 
Skylar-BarlowAuthor Commented:
thanks Norie.  it brings the change into my existings sheet.  how can i modify this, so that it create the new worksheet "After" and pastes the data there?
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
MurpheyApplication ConsultantCommented:
Is the heading the only difference???
0
 
Skylar-BarlowAuthor Commented:
yes. only headings to be split as it is shown in the worksheet "AFTER"

simply put, i have the data as shown in worksheet "Before" and i need it to be added as new sheet like shown in the sheet "AFTER"
0
 
NorieVBA ExpertCommented:
Is the 'AFTER' sheet an existing sheet or do you want to add a new sheet, call it 'AFTER', transfer the data from 'BEFORE' to it and then do the split?
0
 
Skylar-BarlowAuthor Commented:
in real work, i do not have "AFTER" worksheet. i have manually created it in this example, to show what i am looking for as result.

so, i only have the workbook called "BEFORE", so i need to run the macro, so that it creates the worksheet "AFTER"
0
 
MurpheyApplication ConsultantCommented:
You can use the standard substring function from excel to take the right part of the string,

I prefer VB-Functions over VB-Subroutines,

=GetPart(sourceCell;"/";1) gives the first label part
=GetPart(sourceCell;"/";2) gives the second label part
=GetPart(sourceCell;"/";3) would gives the third if ist exist

(You can replace the "/" by any other value (if required)



Function GetPart(dta As String, sep As String, part As Integer)

Dim DtaPart() As String

DtaPart = Split(dta, sep)
part = part - 1

GetaArt = DtaPart(part)

End Function

Open in new window

0
 
Skylar-BarlowAuthor Commented:
Norie,

Thank you so very much!

this is exactly what i was imagining.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.