Excel data format query

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,

:banghead: 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

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?

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

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

Is this what you are after?

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

[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..

Quote:

---

Originally Posted by austenr

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...

Hi Peter,

Yes you are correct. Sorry I missed that one. :doh:

Hi Peter,

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

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

'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

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.

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

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

Thanks for you patience.

ljf :doh:

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]

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

Unable to get the Find property of the WorksheetFunction class

thanks

ljf

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.

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?

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?

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.

I have just tweeked the column fields and I can get each of the headings through but then it still gives me a runtime error with the code line

wsTarget.Cells(iRow, x) = Right(strText, Len(strText) - WorksheetFunction.Find(":", strText) - 1)

If you would be so kind as to repost your working code, I will then apply this to my data and if it fails then it must be the data that is throwing the code. Thanks for your patience.

I guess one good thing is that I am learning what each of the individual lines of code is doing as I am working though this. Many thanks again.

ljf.

Here is the working code. The line is failing due to No data in the refrenced cell (meaning no text). I added a line to skip if empty..maybe you can see which line causes the error.


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
if Not IsEmpty(ws.Target.cells(lRow,x) ) then
strText = WS.Cells(i - 1 + x, 1)
wsTarget.Cells(lRow, x) = Right(strText, Len(strText)-WorksheetFunction.Find(":", strText) - 1)
End if
Next x
Next i

End With
End Sub

Compile error:

Method or data member not found

and the error line is

If Not IsEmpty(WS.Target.Cells(lRow, x) ) Then

and it has highlighted Target.

thanks again.

Arrg.

Don't know how my clipboard keeps pasting code I know I edited.

Should be wsTarget not ws.Target (remove the . after WS)

I agree arrg.

It is clearing the data ok, and completing the column headings but that appears to be it. There are no errors either, so it must be something to do with the If Not IsEmpty line that is saying there is no data or it is not reading anything after the ":"

Any thoughts?

Thanks

ljf

OMG, I what a stupid I am.

Change to

If not isEmpty (ws.cells(i,1)) then

In my infinite wisdom, I told it to check the destination sheet for the data, not the source sheet. Sorry bro. Total brain fade.

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
if Not IsEmpty(ws.Target.cells(lRow,x) ) then
strText = WS.Cells(i - 1 + i, 1)
wsTarget.Cells(lRow, x) = Right(strText, Len(strText)-WorksheetFunction.Find(":", strText) - 1)
lRow = lRow + 1
End if

Next x
Next i


My god i fubarred what was once working code..above is fixed.

My god. Sorry brother...let me re-work this thing and make sure it works right. I will re-upload the sample file with functioning code again. I must be losing my mind.
EDIT:
Now I am really confused. The file I uploaded on page one, with sample, works perfectly. I would download that again and run THAT code against your data. But this is really making me nutso.

Further..this is the code that has worked time and again, as posted on page 1 before things got ugly.

[vba]Sub PutDataInColsPlease()

'dimension variables
'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 every 4 rows
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]

Note: With Option Explicit I caught one error in the variable declaration. THat is now fixed in the code above.

Yikes

Uable to get the Find property of the WorksheetFunction class

I have gone back to the start and get the same errors as when we first started this conversation. first the lRow change that to iRow then the value of x goes and so on. Not sure if it is just me but I have tried all combos. The time that you have done on this is probably about the same amount of time as me copying each portion of data manually.
I don't want to waste any more of your time on this so I will see if I can locate someone to look at the data from my end to see if there is something wrong with that. Thanks again.

Quote:

---

Originally Posted by ljf

I have gone back to the start and get the same errors as when we first started this conversation. first the lRow change that to iRow then the value of x goes and so on. Not sure if it is just me but I have tried all combos. The time that you have done on this is probably about the same amount of time as me copying each portion of data manually.
I don't want to waste any more of your time on this so I will see if I can locate someone to look at the data from my end to see if there is something wrong with that. Thanks again.

---

Don't know what to tell you. I downloaded the file that appears on page 1, and it worked perfectly (with the exception of the variable declaration error. I declared the variable iRow but used lRow in the code. Changing the variable declaration to lRow fixed that)

Sorry you can't seem to get it to work, it is kind of hard for me to diagnose the problem when the sample set worked fine (with two adjustments for missing :.

As I said, the data has to be laid out the way the sample was and each row has to have a colon.

If you download the file I attached, and hit the button, you can see that the code works.

My :2p:
This may or may not be part of the problem.
The worksheet provided has a reference to the Microsoft Outlook 12 library. I recieved the same initial error as did ljf. I changed the reference to my version and it worked. I then realized the reference was not needed and removed the reference and it worked.

Good catch.

I am sorry to ask again but which line needs to be deleted/changed?

The code provided by XLGibbs works as provided, so you do not have to change any of the lines.
The problem maybe that you do not have the same version of Excel as XLGibbs has. I have version 9 which is Excel 2000. XLGibbs has version 12. In XLGibbs example he has referenced Microsoft Outlook 12.0 Object Library.
In the Visual Basic Editor Window or VBE select the Topmost menu Tools: and under Tools: select References: look for this entry ~MISSING: Microsoft Outlook 12.0 Object Library and deselect this option.
I hope this helps!
And for future reference XLGibbs is 99.99999 % accurate :thumb

Thank you very much. Now all is well and the saga is now complete. A special thanks to XLGibbs for his patience. Good job.

:thumb

Sorry about that, I thought I wrote that one in 2000! When I tested it in 2000 it didn't matter because I have both libraries installed. !

At least it is resolved. Thanks for picking up on that CarlA

(Note to self, make sure to use 2000 for uploads..:LOL)

Hi!
How can i give reference of one cell in another sheet?
Thanks!