How to seperate and cut cells to the next one in Excel VBA?-CodePudding

I have a cell with ~230 characters (without space), and I would like to find '%' symbol in the cell then cut the rest of the cell and paste in the next cell to the bottom. Do it until all % found.

Sub test()
Dim c As Range
Range("B12").Select
i = 1
Set c = Selection.Find(What:="%", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
    Do
    c.Cut c.Offset(i, 0)
    Set c = Selection.Find(What:="%", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        i = i   1
    Loop Until c Is Nothing
End If
End Sub

CodePudding user response：

Using Split would be significantly easier. We can take the entire text into a String variable, then split it based on every occurrence of % and then output the array to the cells, skipping blanks and re-adding the % character.

Sub Example()
    Dim InputRange As Range
    Set InputRange = Range("B12")

    Dim InputText As String
    InputText = InputRange.Value
    
    Dim TextArray() As String
    TextArray = Split(InputText, "%")
    
    Dim i As Long
    For i = 0 To UBound(TextArray)
        If TextArray(i) <> "" Then
            InputRange = TextArray(i) & IIf(i <> UBound(TextArray), "%", "")
            Set InputRange = InputRange.Offset(1, 0)
        End If
    Next
End Sub