Separating data in different columns in Microsoft Excel

[akhi1100]

I have data of different companies like names, addresses, phone numbers and emails in one column of an Excel workbook. How do I separate these columns using Excel formulas?
Here is the sample data:

<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: inherit;">America
Dan Wilson
Ogilvy PR Worldwide
Bingham Farms, MI: 32270 Telegraph Road,
Suite 200, Bingham Farms, MI 48025
OPRGenpact@ogilvy.com
+1 212-880-5346

India
Rudra Bose
Genesis Burson-Marsteller
Unitech Infospace, Central Park II,
Sector 48, Gurgaon, Haryana
+91 124 441 7592

Europe
Quintin Keanie
Ogilvy Public Relations
Berkshire: Vandervell House,
Vanwall Business Park, Maidenhead,
Berkshire SL6 4UB, England, United Kingdom
genpactuk@uk.ogilvypr.com
+44 207 227 5200</code>

 

[pmich]

The total no of lines in each address vary. So the following code will extract each data and put in adjacent cells.
Try and let me know. Though some address do not have Email ID, if you still need to have Email ID and Ph Num in particular columns, I can make a try.

Private Sub cmdExtractDataFromColToRow_Click()
 Dim UsrData As String
 Dim UsrDataOld As String
 Dim DatNum As Integer
 Dim LastRecNum As Long
 Dim NowRow As Long
 Dim CopRow As Long
   
 Check_Open_File ("FullAdrs_29July2015.xlsx")
 Sheets("AdrsFull").Select
 Range("A2").Select
 LastRecNum = Cells(Rows.Count, "A").End(xlUp).Row 'to go to last data cell inspite of blank cells
 DatNum = DatNum + 1
 NowRow = ActiveCell.Row
 CopRow = NowRow
NxtChk:
 Do Until NowRow = LastRecNum + 1
  If Selection.Offset(0, 0).Value <> "" Then
   UsrData = Selection.Offset(0, 0).Value
NewChck:
   If InStr(UsrData, ",") > 0 Then
    UsrDataOld = Trim(UsrData)
    UsrData = Trim(Left(UsrDataOld, InStr(UsrDataOld, ",") - 1))
    UsrDataOld = Trim(Mid(UsrDataOld, InStr(UsrDataOld, ",") + 1))
    Cells(CopRow, DatNum + 1).Value = UsrData
    UsrData = UsrDataOld
    If Len(UsrData) > 0 Then
     DatNum = DatNum + 1
    End If
    GoTo NewChck
   Else
    If UsrData <> "" Then
     Cells(CopRow, DatNum + 1).Value = UsrData
     Selection.Offset(1, 0).Select
     NowRow = ActiveCell.Row
     DatNum = DatNum + 1
     GoTo NxtChk
    Else
     Selection.Offset(1, 0).Select
     NowRow = ActiveCell.Row
     DatNum = DatNum + 1
     GoTo NxtChk
    End If 'UsrData <> ""
   End If 'InStr(usrdata, ",") > 0
  Else
   Selection.Offset(1, 0).Select
   NowRow = ActiveCell.Row
   CopRow = CopRow + 1
   DatNum = 1
   GoTo NxtChk
  End If 'Selection.Offset(0, 0).Value <> ""
 Loop
End Sub

Some other expert may also help you with some better code.

 

[akhi1100]

Thanks for responding. However, when I ran the macro it gave me an error Check_Open_File command. I have just started learning vba so I would prefer that the answer is in excel. If it is not possible excel than please provide some comments for the vba code, so that I can understand it easily.

 

[pmich]

Check_Open_File is an user defined function. So, instead of the following code:

Check_Open_File ("FullAdrs_29July2015.xlsx")

you can use this line of code:

Workbooks.Open Filename:="D:\MyFolder\MyFile.xls"

Instead of "D:\MyFolder\" you have to write the path of your file and instead of "MyFile.xls" you have to write the name of your file, whether it is with xls extension or with xlsx extension.

 

[akhi1100]

After the correction suggested by you it is showing the following message:

Run time error '9':
Subscript out of range

 

[pmich]

Having changed the filename, check your Sheet name and range.
My Sheet name is AdrsFull. I have your data in Column A. So my code is:

Sheets("AdrsFull").Select
Range("A2").Select

Type your Sheet name and the column name in which you have the data.
Then at the left extreme of the following code, that is on the border of the code window, which is outside the code area

Range("A2").Select

click and you will see a colored round. The color of this code line also will be changed. Now, click the tiny triangle above this code editor. It will run the code. But the code will stop at the line where you have clicked. From that point you press F8. It will run the code step by step. Please inform me at which code line you get the error message. Some other expert may give you a better solution. Otherwise, I will try to help you.

 

[akhi1100]

Having changed the filename, check your Sheet name and range.
My Sheet name is AdrsFull. I have your data in Column A. So my code is:

Sheets("AdrsFull").Select
Range("A2").Select

Type your Sheet name and the column name in which you have the data.
Then at the left extreme of the following code, that is on the border of the code window, which is outside the code area

Range("A2").Select

click and you will see a colored round. The color of this code line also will be changed. Now, click the tiny triangle above this code editor. It will run the code. But the code will stop at the line where you have clicked. From that point you press F8. It will run the code step by step. Please inform me at which code line you get the error message. Some other expert may give you a better solution. Otherwise, I will try to help you.

I changed the sheet name to Sheet 1 and I also have data in column A so I did not change Range("A2").Select. But I am still getting the same error.

 

[pmich]

What is your file's name and sheet's name? Check your Sheet name whether it is Sheet 1 or Sheet1. Please paste your code with the file name and sheet name. Run your code step by step as per my previous reply and inform me at which code line you get the error message.