Macro to split numbers and text to respective columns

[RAM72]

Macro to split numbers and text to distinct columns

Expected results next to adjacent columns IN B 19054010 COLUMNS C: INFANT BREAD

Columns A
19054010 INFANT BREAD
19059090 BAKERIES

 

[Deepak]

There are various ways to do so.

I have arranged some of them. you may use the same fn in vba too.

 

[mohadin]

HI
as I understand
please check the attachment
by the way it is not a macro but a UDF
hope it meets your requirement

 

[RAM72]

HI
as I understand
please check the attachment
by the way it is not a macro but a UDF
hope it meets your requirement

Hi

Just check in working but however could you look in an insight where there are numbers in the description in red
see attached

 

[RAM72]

There are various ways to do so.

I have arranged some of them. you may use the same fn in vba too.

Hi Deepak

Not giving expected results , could you look in

Thanks

 

[YasserKhalil]

Can you post the desired results ?

 

[RAM72]

Annexed sample of expected results in column B and C

 

[Deepak]

Hi Deepak

Not giving expected results , could you look in

Thanks

You have wrongly adapted the fn. that are just sample. You need to adopt as per need.

 

[Deepak]

Check this.

Just change the range.

Sub split()
    Range("A2:A9").TextToColumns Destination:=Range("D2"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(8, 1))
End Sub

 

[RAM72]

Check this.

Just change the range.

Sub split()
    Range("A2:A9").TextToColumns Destination:=Range("D2"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(8, 1))
End Sub

Now it working thanks for help

 

[YasserKhalil]

Try this

Sub Split()
    Dim Arr, I As Long, Str As String
   
    Arr = Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value
   
    For I = LBound(Arr) To UBound(Arr)
        Cells(I + 1, 2) = VBA.Split(Arr(I, 1), " ")(0)
        Cells(I + 1, 3) = Replace(Arr(I, 1), VBA.Split(Arr(I, 1), " ")(0), "")
    Next I
End Sub

 

[RAM72]

Try this

Sub Split()
    Dim Arr, I As Long, Str As String
  
    Arr = Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value
  
    For I = LBound(Arr) To UBound(Arr)
        Cells(I + 1, 2) = VBA.Split(Arr(I, 1), " ")(0)
        Cells(I + 1, 3) = Replace(Arr(I, 1), VBA.Split(Arr(I, 1), " ")(0), "")
    Next I
End Sub

Thank you working as charm

 

[YasserKhalil]

You're welcome. Glad I can offer some help
Regards

 

[jindon]

RAM72

You will have problem when 2nd set of characters contains the 1st set of characters with REPLACE function.

If you like to use Split function, it should be

Sub test()
    Dim r As Range
    For Each r In Range("a2", Range("a" & Rows.Count).End(xlUp))
        If r.Value Like "* *" Then
            r(, 2).Resize(, 2).Value = Split(r.Value, " ", 2)
        End If
    Next
End Sub

 

[RAM72]

RAM72

You will have problem when 2nd set of characters contains the 1st set of characters with REPLACE function.

If you like to use Split function, it should be

Sub test()
    Dim r As Range
    For Each r In Range("a2", Range("a" & Rows.Count).End(xlUp))
        If r.Value Like "* *" Then
            r(, 2).Resize(, 2).Value = Split(r.Value, " ", 2)
        End If
    Next
End Sub

Thanks for this solution Jindon, working

 

[mohadin]

Hi
Mr. Jindon perfection as ever.
as per Mr. yaser
there is minor thing which is ; there is a trailing space.
I did that but works for the text not for numbers

Sub yaser()
    Dim Arr, I As Long, Str As String
  
    Arr = Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value
  
    For I = LBound(Arr) To UBound(Arr)
        Cells(I + 1, 2) = Trim(VBA.Split(Arr(I, 1), " ")(0))
        Cells(I + 1, 3) = Trim(Replace(Arr(I, 1), VBA.Split(Arr(I, 1), " ")(0), ""))
    Next I
End Sub

 

[jindon]

Try add one line

For I = LBound(Arr) To UBound(Arr)
    Arr(I, 1) = Application.Trim(Arr(I, 1))  '<-- this line
    Cells(I + 1, 2) = Trim(VBA.Split(Arr(I, 1), " ")(0))

 

[mohadin]

Thank you sir