CODEWITHSUNDEEP
vbaexcelsplitdelimiter
GMV
GMV

Reputation: 67

Trying to split a single cell with multiple variables

I have non-microsoft files that have look along the lines of:

>gibberish that changes AAARRGGGHHHH

Now, I have a code to make a new .xlsx file out of this to split using Trying to convert files while keeping the old name.

However, I would like the "A2" cell contents to split with each indivual letter being assigned a cell and then have the former contents deleted. I don't mind if this ends up in A3 till AZ.

Thus, the above example I would like to transform to make it look like:

>gibberish that changes
A A A R R G G G H H H H

To clarify "Gibberish that changes" is not a constant it changes per file I have what is denoted here. Same holds true for the second line.

Based on Split cell string into individual cells

I tried this code:

Dim sVar1 as string
Dim sVar2 as string

I = InStr(1, strX, "A" & "R" & "G" & "H")

sVar1 = mid(strX, 1, I)
sVar2 = mid(strx,i+1)

However, this yields no results. It does not cause the Macro to fail (as I get no error message and the rest of the macro works (changing a file into another format and altering the name), but it doesn't do anything. I would like to use the string as the files constantly change in contents and order in cell A2.

I also have no true delimiter as things like ARRGHHHH is written as one word, is that causing the issue?

Upvotes: 0

Views: 164

Answers (4)

Gary's Student
Gary's Student

Reputation: 96763

This will parse A2 into its characters and place the characters next to A2, each in its own cell:

Sub dural()
With Range("A2")
    v = .Value
    L = Len(v)
    For i = 1 To L
        .Offset(0, i).Value = Mid(v, i, 1)
    Next i
End With
End Sub

enter image description here

EDIT#1:

This will handle both a range of input cells and the clearing of the original input data. Before:

enter image description here

The new macro:

Sub dural2()
    Dim rng As Range, r As Range, v As Variant
    Dim L As Long, i As Long
    Set rng = Range("A2:A40")
        For Each r In rng
        v = r.Value
        L = Len(v)
        For i = 1 To L
            r.Offset(0, i - 1).Value = Mid(v, i, 1)
        Next i
    Next r
End Sub

The result:

enter image description here

Upvotes: 1

J. felix
J. felix

Reputation: 31

Try this.

    Sub dural()
    With Range("A2")
        v = .Value
        L = Len(v)
        For i = 0 To L - 1
            If i = 0 Then
                .Offset(0, i).Value = Left(v, 1)

            Else
                .Offset(0, i).Value = Mid(v, i, 1)
            End If
        Next i
    End With
    End Sub

Input

output

Upvotes: 0

user3598756
user3598756

Reputation: 29421

my 0.02 with Character object

Sub main()
    With Range("A2")
        For i = 1 To Len(.Value)
            .Offset(, i) = .Characters(i, 1).Text
        Next i
    End With
End Sub

Upvotes: 4

Brian
Brian

Reputation: 2108

Would this be helpful at all?

Sub Test()

Dim i As Integer
Dim num As Integer

num = Len(Range("A1"))

For i = 1 To num
    Debug.Print Mid(Range("A1"), i, 1)
Next

End Sub

Upvotes: 0

Related Questions