PDA

View Full Version : Excel data format query



ljf
12-28-2006, 04:21 PM
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

XLGibbs
12-28-2006, 04:49 PM
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
12-28-2006, 04:58 PM
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
12-28-2006, 05:00 PM
Are there always the same exact number of rows per data set, and always only 1 row separating them?

austenr
12-28-2006, 05:11 PM
Is this what you are after?

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

XLGibbs
12-28-2006, 05:34 PM
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


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
12-28-2006, 05:36 PM
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
12-29-2006, 07:08 AM
Hi Peter,

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

ljf
01-07-2007, 11:09 PM
Hi Peter,

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

XLGibbs
01-08-2007, 05:50 AM
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
01-08-2007, 05:51 AM
'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
01-08-2007, 10:34 PM
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
01-09-2007, 05:06 AM
Dang, I thought I took that line out, must not have recopied the code to the clipboard. Delete that line.

ljf
01-09-2007, 06:32 PM
Now I get Run-time error '1004' Application-defined or object-definded error.

Thanks for you patience.

ljf :doh:

XLGibbs
01-09-2007, 06:45 PM
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.

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

ljf
01-09-2007, 11:41 PM
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
01-10-2007, 05:13 AM
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
01-10-2007, 05:18 AM
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
01-10-2007, 06:19 PM
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
01-10-2007, 06:30 PM
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.

ljf
01-10-2007, 06:42 PM
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)

ljf
01-10-2007, 07:06 PM
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.

XLGibbs
01-11-2007, 05:39 AM
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

ljf
01-11-2007, 06:44 PM
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.

XLGibbs
01-11-2007, 06:53 PM
Arrg.

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

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

ljf
01-11-2007, 07:04 PM
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

XLGibbs
01-11-2007, 07:09 PM
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.

XLGibbs
01-11-2007, 07:11 PM
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.

XLGibbs
01-11-2007, 07:15 PM
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.

XLGibbs
01-11-2007, 07:18 PM
Further..this is the code that has worked time and again, as posted on page 1 before things got ugly.

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




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

ljf
01-11-2007, 07:39 PM
Yikes

Uable to get the Find property of the WorksheetFunction class

ljf
01-11-2007, 11:48 PM
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.

XLGibbs
01-12-2007, 10:51 AM
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.

Carl A
01-13-2007, 12:25 PM
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.

XLGibbs
01-13-2007, 03:27 PM
Good catch.

ljf
01-13-2007, 05:15 PM
I am sorry to ask again but which line needs to be deleted/changed?

Carl A
01-13-2007, 06:42 PM
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

ljf
01-13-2007, 11:06 PM
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

XLGibbs
01-14-2007, 06:59 AM
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)

SureshSuresh
01-15-2007, 11:53 PM
Hi!
How can i give reference of one cell in another sheet?
Thanks!