VBA to split text in different coloums

aliaslamy2k

Active Member
Joined
Sep 15, 2009
Messages
416
Office Version
  1. 2019
Platform
  1. Windows
Hello,

I would like to split the text after every space in column A to different columns. I got a vba code but works only on 1st row, I need to split the text for entire column A.


Sub NameTest()

Dim txt As String
Dim i As Integer
Dim FullName As Variant

txt = ActiveCell.Value

FullName = Split(txt, " ")
For i = 0 To UBound(FullName)
Cells(1, i + 1).Value = FullName(i)

Next i
End Sub
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
I would like to split the text after every space in column A to different columns.
Would this (using Text To Columns) do what you want?
Test with a copy of your data.

VBA Code:
Sub TTC()
  Columns("A:A").TextToColumns DataType:=xlDelimited, Space:=True, Other:=False
End Sub
 
Upvote 0
Hello Peter,

Below is the data and i used your macro to split. It worked fine, but the result is not satisfactory. I would highly appreciate if i can get the output as below.

Spon Checklist.xlsx
A
11/7/2020
2Company
3Sponsored List
4Total Sponsored :
5Page 1 of 75
6act
7No ID No. Name Nationality Gender RP Exp date Remarks
81 29005023134 Monirhossain Sheikh Bangladesh Male 2017-06-07 Under Process
92 28505026454 Mohammadismail Hossain Bangladesh Male 2017-06-19 Under Process
103 28552450200 Rochan Khatri Chhetri Nepal Male 2018-06-23 Under Process
114 29652428300 Anash Sah Nepal Male 2018-07-19 Under Process
125 29852405234 Ashok Kumar Sah Nepal Male 2018-08-09 Under Process
136 28835667765 Fazal Abdul Gani Kalsekar India Male 2018-12-09 Under Process
147 29035635543 Anantharaj Veerapathiran India Male 2018-12-12 Under Process
158 28305011765 Mohammad Mamunur Rasid Molla Bangladesh Male 2019-05-24 RP Expired
169 28005018856 Mamun Ali Bangladesh Male 2019-06-05 RP Expired
1710 28005018500 Suman Miah Bangladesh Male 2019-06-05 RP Expired
1811 28105014934 Mohammedtoiab Ali Bangladesh Male 2019-06-05 RP Expired
1912 28605018594 Mdmezbah Uddin Bangladesh Male 2019-06-05 RP Expired
2013 28705021976 Sumon Motin Bangladesh Male 2019-06-05 RP Expired
2114 28705021728 Mohammadbillal Hossain Bangladesh Male 2019-06-05 RP Expired
2215 25505024168 Zahirul Islam Bangladesh Male 2019-06-05 RP Expired
2316 28805554172 Mohammadliton Miah Bangladesh Male 2019-06-05 RP Expired
2417 28905026572 Mehedi Hasan Bangladesh Male 2019-06-05 RP Expired
2518 28905024577 Mdalamgir Hossain Bangladesh Male 2019-06-05 RP Expired
2619 29005024504 Rasheduzzaman Uddin Bangladesh Male 2019-06-05 RP Expired
2720 29005023405 Mohammadmajahrul Islam Bangladesh Male 2019-06-05 RP Expired
2821 29005024337 Shazzad Hossain Bangladesh Male 2019-06-05 RP Expired
2922 29105014587 Mohammadrafiqul Islam Bangladesh Male 2019-06-05 RP Expired
3023 29205014589 Naem Mia Bangladesh Male 2019-06-05 RP Expired
3124 29205014588 Rasel Mia Bangladesh Male 2019-06-05 RP Expired
3225 29205014791 Iqbal Hossain Bangladesh Male 2019-06-05 RP Expired
33* : Escape
341/7/2020
35Company
36Sponsored List
37Total Sponsored :
38Page 2 of 75
39act
40No ID No. Name Nationality Gender RP Exp date Remarks
4126 29205556303 Md Suruj Mia Bangladesh Male 2019-06-05 RP Expired
4227 29405558133 Mohammadshipon Miah Bangladesh Male 2019-06-05 RP Expired
4328 29505554189 Shaidul Islam Bangladesh Male 2019-06-05 RP Expired
4429 29605044368 Mdpavel Hossain Bangladesh Male 2019-06-05 RP Expired
4530 29605055369 Mdkhairul Islam Bangladesh Male 2019-06-05 RP Expired
4631 29605055811 Mohammad Aminur Rahman Bangladesh Male 2019-06-05 RP Expired
4732 28505034979 Mohammed Abdul Karim Bangladesh Male 2019-06-06 RP Expired
4833 28505055980 Md Anarul Haque Subuj Bangladesh Male 2019-06-06 RP Expired
4934 28905076421 Mamun Ali Bangladesh Male 2019-06-06 RP Expired
Sheet1



I would like to have below output from above data.

Spon Checklist.xlsx
JKLMNOP
7NoQID noNameNationalityGenderRP Exp dateRemarks
8129005023134Monirhossain SheikhBangladeshMale6/7/2017Under Process
9228505026454Mohammadismail HossainBangladeshMale6/19/2017Under Process
10328552450200Rochan Khatri ChhetriNepalMale6/23/2018Under Process
11429652428300Mohammad Mamunur Rasid MollaBangladeshMale5/24/2019RP Expired
Sheet1
 
Upvote 0
the result is not satisfactory.
Not too surprising since you had said this ;)
would like to split the text after every space in column A to different columns.
I'll consider an alternative method and post again later.

However, this could be very difficult to get exactly right if you have any Nationality values that consist of more than one word. (eg 'South Korea' or 'New Zealand')
You need some logic to determine where to split your text. If multi-name nationalities are possible, then what would be the logic of where to split this text for Name and Nationality?
1 29005023134 Word1 Word2 Word3 Word4 Male 2017-06-07 Under Process

Perhaps you have a list of all possible nationalities in your workbook?
 
Upvote 0
Try this with a copy of your data.
It assumes that all nationality values are single words.

VBA Code:
Sub Split_Text()
  Dim a As Variant, b As Variant, bits As Variant, dateparts As Variant
  Dim i As Long, j As Long, k As Long
 
  With Range("A8", Range("A" & Rows.Count).End(xlUp))
    a = .Value
    ReDim b(1 To UBound(a), 1 To 7)
    For i = 1 To UBound(a)
      bits = Split(a(i, 1))
      If IsNumeric(bits(0)) And UBound(bits) > 5 Then
        b(i, 1) = Val(bits(0))
        b(i, 2) = bits(1)
        For j = 5 To UBound(bits)
          If InStr(1, bits(j), "-") > 0 Then Exit For
        Next j
        If j < UBound(bits) Then
          For k = 2 To j - 3
            b(i, 3) = b(i, 3) & " " & bits(k)
          Next k
          b(i, 3) = Mid(b(i, 3), 2)
          b(i, 4) = bits(j - 2)
          b(i, 5) = bits(j - 1)
          dateparts = Split(bits(j), "-")
          b(i, 6) = DateSerial(dateparts(0), dateparts(1), dateparts(2))
          For k = j + 1 To UBound(bits)
            b(i, 7) = b(i, 7) & " " & bits(k)
          Next k
          b(i, 7) = Mid(b(i, 7), 2)
        End If
      End If
    Next i
    .Offset(, 14).NumberFormat = "m/d/yyyy"
    .Offset(, 9).Resize(UBound(b, 1), UBound(b, 2)).Value = b
  End With
End Sub
 
Last edited:
Upvote 0
Hello Peter,
This code is awesome!,
The only problem is it work only half way through, i have more than 2000 rows of data and it is leaving many rows blank. Below is the screenshot.

Thank you so much :)

Book1
ABCDEFGHIJKLMNOP
557422 28935625443 Md Tarique Anwer India Male 2020-01-04 RP Expired42228935625443Md Tarique AnwerIndiaMale1/4/2020RP Expired
558423 28035637762 Soman Sineesh Sivadasan Soman India Male 2020-01-05 RP Expired42328035637762Soman Sineesh Sivadasan SomanIndiaMale1/5/2020RP Expired
559424 29035610066 Rahul Raviprakash India Male 2020-01-07 RP Expired42429035610066Rahul RaviprakashIndiaMale1/7/2020RP Expired
560425 28005022129 Mosarof Hossain Bangladesh Male 2020-01-0842528005022129
561* : Escape Registration Date
5621/7/2020
563Company Number : 12-8185-01 /
564Company Sponsored Persons List
565Total Sponsored : 1871
566Page 18 of 75
567
568No QID No. Name Nationality Gender RP Exp date Remarks
569426 28335652363 Samad Ali Khan Mohammad India Male 2020-01-0842628335652363
570427 26760810080 Domingo Jr Rodriguez David Philippines Male 2020-01-1042726760810080
571428 27235639285 Shaik Pailwan Shareef India Male 2020-01-1242827235639285
572429 28235663122 Shakeel Ahmad Khan India Male 2020-01-1242928235663122
573430 27514408729 Chaminda Prabath Jayasinghe Thuduhenage Srilanka Male 2020-01-1343027514408729
574431 28735662981 Azad Khan Kalam Khan India Male 2020-01-13 Outside Country43128735662981Azad Khan Kalam KhanIndiaMale1/13/2020Outside Country
575432 28005006018 Md Sumon Zomddar Bangladesh Male 2020-01-1443228005006018
576433 28735633076 Mohamed Niyajudeen Sheikdawood India Male 2020-01-1443328735633076
577434 27605009943 Nura Alam Abdul Barek Bangladesh Male 2020-01-1543427605009943
578435 29035614901 Affanali Sadiqueali Syed India Male 2020-01-1543529035614901
579436 28835627528 Deepak Verma India Male 2020-01-1643628835627528
580437 28852431575 Manoj Das Tatma Nepal Male 2020-01-1843728852431575
581438 28305025003 Humayan Kabir Kasem Bepari Bangladesh Male 2020-01-1943828305025003
582439 29005028274 Shohag Hosen Bangladesh Male 2020-01-1943929005028274
583440 29005032128 Mohammad Jalil Miah Bangladesh Male 2020-01-1944029005032128
584441 28405025302 Md Mostak Ur Rahman Bangladesh Male 2020-01-2044128405025302
585442 28505030864 Ezzat Ali Alam Bhuiyan Bangladesh Male 2020-01-2044228505030864
586443 28605023831 Dulal Mohammad Abdul Bangladesh Male 2020-01-2044328605023831
587444 28735643493 Mahammadiqbal Agasi India Male 2020-01-2044428735643493
588445 29105022570 Md Firoj Abdul Aziz Bangladesh Male 2020-01-2044529105022570
589446 29105022620 Rashed Rahman Abdul Malek Bangladesh Male 2020-01-2044629105022620
590447 29205023830 Saiful Islam Aynal Hoque Bangladesh Male 2020-01-2044729205023830
591448 29305020185 Rabiul Kazi Aslam Kazi Bangladesh Male 2020-01-2044829305020185
592449 29405016976 Mohammad Aminur Rahman Bangladesh Male 2020-01-2044929405016976
593450 29505010919 Shahadat Hossain Dulal Bangladesh Male 2020-01-2045029505010919
Sheet1
 
Upvote 0
and it is leaving many rows blank.
To get good results, you have to give good sample data. ;)
Your original sample data isn't like your real data.
The original sample data ..
- had no blank cells in column A
- had no 'real' data rows where there was no Remarks after the date section.

Try this version which now addresses those 2 circumstances I believe.

VBA Code:
Sub Split_Text_v2()
  Dim a As Variant, b As Variant, bits As Variant, dateparts As Variant
  Dim i As Long, j As Long, k As Long
  
  With Range("A8", Range("A" & Rows.Count).End(xlUp))
    a = .Value
    ReDim b(1 To UBound(a), 1 To 7)
    For i = 1 To UBound(a)
      bits = Split(a(i, 1))
      If UBound(bits) > -1 Then
        If IsNumeric(bits(0)) And UBound(bits) > 5 Then
          b(i, 1) = Val(bits(0))
          b(i, 2) = bits(1)
          For j = 5 To UBound(bits)
            If InStr(1, bits(j), "-") > 0 Then Exit For
          Next j
          If j <= UBound(bits) Then
            For k = 2 To j - 3
              b(i, 3) = b(i, 3) & " " & bits(k)
            Next k
            b(i, 3) = Mid(b(i, 3), 2)
            b(i, 4) = bits(j - 2)
            b(i, 5) = bits(j - 1)
            dateparts = Split(bits(j), "-")
            b(i, 6) = DateSerial(dateparts(0), dateparts(1), dateparts(2))
            For k = j + 1 To UBound(bits)
              b(i, 7) = b(i, 7) & " " & bits(k)
            Next k
            b(i, 7) = Mid(b(i, 7), 2)
          End If
        End If
      End If
    Next i
    .Offset(, 14).NumberFormat = "m/d/yyyy"
    .Offset(, 9).Resize(UBound(b, 1), UBound(b, 2)).Value = b
  End With
End Sub
 
Upvote 0
Hello Peter,

Yes, now its PERFECT !

Thank you so much for all your efforts to help me out with this problem. Now i will be able to save alot of time at work.
I will keep in mind to provide good data in future to avoid any confusion.

Thank you once again :)
Regards,
AB
 
Upvote 0

Forum statistics

Threads
1,213,515
Messages
6,114,080
Members
448,548
Latest member
harryls

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top