CODEWITHSUNDEEP
excelvba
stasser
stasser

Reputation: 123

Excel VBA Split function to work in a range

[UDPATED] I try to automate my solution to divide one cell into several others in one row, but still have some issues to divide the data from one cell as below: The final version need to divide range of data in column E starting from E2 (E2:E)

enter image description here

Ok, after some modifications:

    Sub g()


    Dim strInput As String, strOutput As String
    Dim stringValue As String
    Dim LastRowcheck As Long
    Dim n1 As Long
    Dim i As Long
  
    LastRowcheck = Sheets("T4").Range("E" & Rows.Count).End(xlUp).Row
    Sheets("T4").Activate
    
    For n1 = 2 To LastRowcheck
    With Worksheets("T4").Cells(n1, 1)
    stringValue = Sheets("T4").Cells(n1, 5).value
       
    Sheets("T4").Cells(7, n1 + 4) = getPart(stringValue, "price", "price2")
    Sheets("T4").Cells(8, n1 + 4) = getPart(stringValue, "price2", "status")
    Sheets("T4").Cells(9, n1 + 4) = getPart(stringValue, "status", "min")
    Sheets("T4").Cells(10, n1 + 4) = getPart(stringValue, "min", "opt")
    Sheets("T4").Cells(11, n1 + 4) = getPart(stringValue, "opt", "category")
    Sheets("T4").Cells(12, n1 + 4) = getPart(stringValue, "category", "code z")
    Sheets("T4").Cells(13, n1 + 4) = getPart(stringValue, "code z", "", True)
    End With
    Next n1
    Application.DisplayAlerts = False
End Sub

Function getPart(value As String, fromKey As String, toKey As String, Optional isLast As Boolean = False) As String
    Dim pos1 As Long, pos2 As Long
    
    pos1 = InStr(1, value, fromKey & ":")
    
    If (isLast) Then
        pos2 = Len(value)
    Else
        pos2 = InStr(pos1, value, toKey & ":") ' HERE DEBUGGER STOPS
    End If
    
    getPart = Trim$(Mid$(value, pos1, pos2 - pos1))
End Function

Upvotes: 1

Views: 252

Answers (1)

Joffan
Joffan

Reputation: 1480

The following test frame works for all strings of the form where the keyword is a text string either without spaces or with a space-single-character ending. SpecialSpread illustrates a way to use this to take a single cell and spread the split values over the cells to the right.

Function SpecialSplit(Compound As String) As Variant
Dim pos1 As Long, pos2 As Long
Dim firstSplit As Variant
Dim elmts As Integer
Dim elmt As Integer
Dim oneel As String

firstSplit = Split(Compound, ":")
For elmt = LBound(firstSplit) To UBound(firstSplit) - 1
    oneel = firstSplit(elmt + 1)
    pos1 = InStr(oneel, " ")
    pos2 = Len(oneel)
    While pos1 > 0 And pos1 < Len(oneel) - 1
        pos2 = pos1
        pos1 = InStr(pos2 + 1, oneel, " ")
    Wend
    firstSplit(elmt) = firstSplit(elmt) & ":" & Left(oneel, pos2 - 1)
    firstSplit(elmt + 1) = Right(oneel, Len(oneel) - pos2)
Next elmt
    
elmts = UBound(firstSplit) - LBound(firstSplit) ' one shorter
If elmts > 0 Then ReDim Preserve firstSplit(1 To elmts)

SpecialSplit = firstSplit

End Function

Sub SpecialSpread(FromCell As Range)
Dim splitSet As Variant
splitSet = SpecialSplit(FromCell(1).Text)
If UBound(splitSet) >= 0 Then
    FromCell(1).Offset(0, 1).Resize(1, UBound(splitSet) - LBound(splitSet) + 1).value = splitSet
End If
End Sub

Upvotes: 1

Related Questions