Excel data format query

[ljf]

Hi all,

I am new to VBA and have tried to do this via Excel but alas it needs expert help. I have data in a single column as per the text below and I need to place each field in a seperate column. The main problem is that some data has two fields on the one line. Can someone point me in the right direction? I assume that it could search on the colon as this is present in each field but how I do that and move the data to respective columns is beyond me.

Thanks,

ljf.

Name: Mr First_Name Last_Name
Level: Job(Type<->Type)
Phone (BH): 01 2345 6789 Phone (AH): 01 9876 5432
Fax (BH): 01 2345 6789 Fax (AH): 01 9876 5432
Mobile (BH): 0123456789 Mobile (AH): 0987654321
Email (Work): email address
Email (Home): email address
WebPage website url
Address: 3 My Street
SUBURB STATE 1234
Work Areas (Preferred): Any Area

Name: Mr First_Name Last_Name
Level: Job(Type<->Type)
Phone (BH): 01 2345 6789 Phone (AH): 01 9876 5432
Fax (BH): 01 2345 6789 Fax (AH): 01 9876 5432
Mobile (BH): 0123456789 Mobile (AH): 0987654321
Email (Work): email address
Email (Home): email address
WebPage website url
Address: 3 My Street
SUBURB STATE 1234
Work Areas (Preferred): Any Area

[XLGibbs]

So you have this data in one column of excel? or is in a text file of some kind?

And do you want each topic..to become a column name (column for Name, column for Level) etc...and to move the respective data into those columns?

[ljf]

You are correct.

I have the data in a single column in excel but pasted it into a text file for ease of use within this forum. The data starts in cell A1-A11 for the first persons details and then A13-A23 for the next and so on. I would like to move each field (Name:, Level:, Phone (B/H):, Phone (A/H): etc to seperate columns for the first person and then continue on in subsequent rows to fill the data table accordingly. There are about 2500 entries in all thus why I needed to automate the moving of the data.

Thanks for your prompt reply

ljf

[XLGibbs]

Are there always the same exact number of rows per data set, and always only 1 row separating them?

[austenr]

Is this what you are after?

http://www.mrexcel.com/td0083.html

[XLGibbs]

[vba]
Sub PutDataInColsPlease()

'dimension variables
Dim WS As Worksheet, wsTarget As Worksheet
Dim c As Range, rngLook As Range
Dim i As Long, iRow As Long, pos As Long, Pos2 As Long

Set WS = ActiveWorkbook.Sheets("Sheet1") 'set as desired
Set wsTarget = ActiveWorkbook.Sheets("Sheet2") 'set as desired


'assumes data starts in A1
Set rngLook = WS.Range("A1", WS.Cells(Rows.Count, "A").End(xlUp))

With wsTarget

'setup destination sheet
.Cells.Clear
.Range("A1:K1") = Array("Full Name", "Level", "Phone", "Fax" _
& "Mobil", "Work Email", "Home Email", "Web Page URL", "Address", "State", "Work Area")

'perform work
For i = 1 To rngLook.Cells.Count Step 12 'assuming 11 rows of data each with 1 space..
lRow = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
For x = 1 To 11
strText = WS.Cells(i - 1 + x, 1)
wsTarget.Cells(lRow, x) = Right(strText, Len(strText) - WorksheetFunction.Find(":", strText) - 1)

Next x
Next i

End With
End Sub

[/vba]
This code does it. Assumes the data starts in Cell A1 of sheet 1.

The attached is a sample with code and a button to run it. If you want, just copy your 1 column of data into Sheet 1 column A and hit the button. (First "Name" entry must be cell A1)

Also, unless there is a : after each rows topic, it will fail... (In your sample, WEBPAGE and SUBURB STATE do not have : markings to separate the data...but I assume your real data does..

[XLGibbs]

Is this what you are after?

http://www.mrexcel.com/td0083.html

This works too! but there is nothing in the pastespecial: Transpose function that strips out everything left of the colon...

[austenr]

Hi Peter,

Yes you are correct. Sorry I missed that one.

[ljf]

Hi Peter,

I saved and ran the file but got a Compile error: Can't find project or library. and it highlighted 1Row.

[XLGibbs]

lrow should be iRow on this line (the below has been changed, replace the similar line in the code)

iRow = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1

[XLGibbs]

'Better safe than sorry...replace the whole code module with below..

Sub PutDataInColsPlease()

'dimension variables
Dim WS As Worksheet, wsTarget As Worksheet
Dim c As Range, rngLook As Range
Dim i As Long, lRow As Long, pos As Long, Pos2 As Long

Set WS = ActiveWorkbook.Sheets("Sheet1") 'set as desired
Set wsTarget = ActiveWorkbook.Sheets("Sheet2") 'set as desired


'assumes data starts in A1
Set rngLook = WS.Range("A1", WS.Cells(Rows.Count, "A").End(xlUp))

With wsTarget

'setup destination sheet
.Cells.Clear
.Range("A1:K1") = Array("Full Name", "Level", "Phone", "Fax" _
& "Mobil", "Work Email", "Home Email", "Web Page URL", "Address", "State", "Work Area")

'perform work
For i = 1 To rngLook.Cells.Count Step 12 'assuming 11 rows of data each with 1 space..
lRow = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
For x = 1 To 11
strText = WS.Cells(i - 1 + x, 1)
wsTarget.Cells(lRow, x) = Right(strText, Len(strText) - WorksheetFunction.Find(":", strText) - 1)

Next x
Next i

End With
End Sub

[ljf]

Sorry to be a pain but now I get a Compile error: Can't find project or library and it highlights the x in the following line-
For x = 1 To 11

There were also 3 instances of 1Row which I altered to iRow.

thanks in anticipation.

[XLGibbs]

Dang, I thought I took that line out, must not have recopied the code to the clipboard. Delete that line.

[ljf]

Now I get Run-time error '1004' Application-defined or object-definded error.

Thanks for you patience.

ljf

[XLGibbs]

Hmm...

Which line?
And looking at the code, the below appears correct to me

When you paste the below into the module, click on the Set WS line and hit the F9 key. When you run the code it will stop there. Use the F8 key to "Step through" the code during testing and let me know which line fails..
with that error.
[vba]
Sub PutDataInColsPlease()

'dimension variables
Dim WS As Worksheet, wsTarget As Worksheet
Dim c As Range, rngLook As Range
Dim i As Long, lRow As Long, pos As Long, Pos2 As Long

Set WS = ActiveWorkbook.Sheets("Sheet1") 'set as desired
Set wsTarget = ActiveWorkbook.Sheets("Sheet2") 'set as desired


'assumes data starts in A1
Set rngLook = WS.Range(cells(1,1), WS.Cells(Rows.Count,1).End(xlUp))

With wsTarget

'setup destination sheet
.Cells.Clear
.Range("A1:K1") = Array("Full Name", "Level", "Phone", "Fax" _
& "Mobil", "Work Email", "Home Email", "Web Page URL", "Address", "State", "Work Area")

'perform work
For i = 1 To rngLook.Cells.Count Step 12 'assuming 11 rows of data each with 1 space..
lRow = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
For x = 1 To 11
strText = WS.Cells(i - 1 + x, 1)
wsTarget.Cells(lRow, x) = Right(strText, Len(strText) - WorksheetFunction.Find(":", strText) - 1)

Next x
Next i

End With
End Sub[/vba]

[ljf]

using the above code I now get the following RT error 1004

Unable to get the Find property of the WorksheetFunction class

thanks

ljf

[XLGibbs]

That might happen if the ranges are not looking at the correct columns. When I wrote this code originally, and it worked on using the sample of data you posted, the data was in column A, starting at row # 1. If the data does not start at row number 1, it would fail on the first pass because the : would not be in the cell.

Also, if the : is not in every line as I said, it will also cause a problem.

[XLGibbs]

Also, I just downloaded the file that was uploaded as a sample, and that works perfectly. So the code is fine provided the data is as you demonstrated....is the data laid out differently?

[ljf]

I tried the code with the original file and it still does not work for me. With the other data, there may be some fields that are blank ie

Phone (BH):

would that also cause a problem?

[XLGibbs]

Well, my code worked with the sample you posted. if the data isn't consistent (11 rows of data, 1 space, 11 rows of data) and if each row doesn't have the : it won't work properly.