Transform data to Columns

[James Niven]

Hi All,

I need some assistance with this sample code I have been playing with.
I have uploaded a sample excel file I have been trying to adjust to suit my needs. Let me explain what I am trying to acheive.

On the tab named "Sample Output" is the desired output once the macro is run.

On tab named "Call Details" is the data I wish to convert to columns, there are rows and rows of them and many separate files. Column B you will see Format, Slogan, Licensed on each row etc etc down the column. These names all have a colon : after them when I paste into excel and once divded into column C using text to columns they disappear.

My first issue is Cell A23 is the frequency of the radio station, this falls to a second row and not in line with the rest of the data and not under the correct column which should be Column B when the macro is run, of course not all of the blocks of data are the same shape and some will not have the same headings if you will. So I am not too sure how to handle this in code.

Next, I am open to ideas here. Under the heading of History beginning in column B, row 13 highlighted in yellow is another issue I am unsure of how to handle. maybe before I split Column B up into two columns using the colon : I could go in and rename these headers in the yellow area, Owner1, Format1, Slogan1, Call Letters1 and give these their own colum, but since the data is under the heading they will not go under any columns. I could display as in my Sample Output, but I have not been able to perform this. I am open to ideas here of how best to handle this.

I plan to transfer this all to a Access database once I have this in the desired format.

Any help will be grateful.

[parttime_guy]

Hi James,

I tried opening the file - does'nt seem to open. I maybe having some Excel compatibility issues.

Could you re-attach the file in .xls format

Thanks and Best regards

[James Niven]

Hi Parttime_guy,

The attached spreadsheet is in Excel 2007 version. I have attached an Excel 2003 version, you should be able to open, let me know if you have any other questions!!

James

[parttime_guy]

Hi James,

I have inserted a new sub "Do_next" in your file which will automatically run after your sub "parseMeters". Please test the attachement.

......Hope this helps!

Best Regards

[parttime_guy]

Hi James,

Have u tested the above attachment - Does it work to your requirements. Can I have a feedback.

Thanks & Best Regards

[James Niven]

Hi Parttime_Guy,

Sorry I have not replied, been out of town on business and just had a chance to read my emails this morning!!

I looked at your solution to my question and Yes it does do what I want, Thank You!!
Is there any way to remove the excess blank spaces in every cell at the beginning of the text due to the separation?

Any ideas what I could do or be the best action to answer my second part of my question?

"Next, I am open to ideas here. Under the heading of History beginning in column B, row 13 highlighted in yellow is another issue I am unsure of how to handle. maybe before I split Column B up into two columns using the colon : I could go in and rename these headers in the yellow area, Owner1, Format1, Slogan1, Call Letters1 and give these their own colum, but since the data is under the heading they will not go under any columns. I could display as in my Sample Output, but I have not been able to perform this. I am open to ideas here of how best to handle this"


Thanks

James

[parttime_guy]

Hi James,

Problem 1 solved (Check the new code) - its running a little slow but works.

Problem 2 - Gimme sometime or I think we both would require help from the wizards on vbaexpress.com

Best regards

[Bob Phillips]

Try this

[vba]

Sub parseMeters()
Dim strTarget0, strTarget1, strTemp, strMtr As String
Dim wsht As Worksheet
Dim ThisR, FirstR, LastR, NextR As Long
Dim lngI, lngJ As Long
Dim ThisC, FirstC, LastC, NextC As Integer

Application.ScreenUpdating = True

' this wb assumes that data exists on a worksheet named "Call Details"
' to change source sheet name edit strTarget1 below
' to change destination sheet name edit strTarget0 below
strTarget1 = "Call Details"
strTarget0 = "Output"

' activate source sheet
Worksheets(strTarget1).Activate
Range("a1").Select

' find last used row & col
LastR = Cells.Find(what:="*", searchdirection:=xlPrevious, searchorder:=xlByRows).Row
LastC = Cells.Find(what:="*", searchdirection:=xlPrevious, searchorder:=xlByColumns).Column

' if sheet "Output" exists delete it
On Error Resume Next
Sheets(strTarget0).Delete
Worksheets(strTarget1).Activate
On Error GoTo 0

' insert blank sheet
Worksheets.Add().Name = strTarget0
Cells(1, 1).Value = "Callsign"
Cells(1, 2).Value = "Freq"
Cells(1, 3).Value = "Format"
Cells(1, 4).Value = "Shows"
Cells(1, 5).Value = "Slogan"
Cells(1, 6).Value = "Licensed"
Cells(1, 7).Value = "Market"
Cells(1, 8).Value = "Owner"
Cells(1, 9).Value = "Co-owned"
Cells(1, 10).Value = "Website"
Cells(1, 11).Value = "Began Operation"
Cells(1, 12).Value = "Facilities"
Cells(1, 13).Value = "Transmitter"
Cells(1, 14).Value = "History"
Cells(1, 15).Value = "App"

ThisR = 2 ' destination sheet row number
For lngJ = 1 To LastR ' source worksheet row number

' check col 1 for CallSign
strTemp = Sheets(strTarget1).Cells(lngJ, 1).Value
If strTemp <> Empty Then ' if not blank it is CallSign
ThisR = ThisR + 1 ' add destination row
Cells(ThisR, 1) = Sheets(strTarget1).Cells(lngJ, 1).Value ' paste sn
End If

With Sheets(strTarget1)

' parse meter text & value
strMtr = .Cells(lngJ, 2).Value
Select Case strMtr
Case "Freq": Cells(ThisR, 2).Value = Trimmed(.Cells(lngJ, 3).Value) ' paste Value
Case "Format": Cells(ThisR, 3).Value = Trimmed(.Cells(lngJ, 3).Value)
Case "Shows": Cells(ThisR, 4).Value = Trimmed(.Cells(lngJ, 3).Value)
Case "Slogan": Cells(ThisR, 5).Value = Trimmed(.Cells(lngJ, 3).Value)
Case "Licensed": Cells(ThisR, 6).Value = Trimmed(.Cells(lngJ, 3).Value)
Case "Market": Cells(ThisR, 7).Value = Trimmed(.Cells(lngJ, 3).Value)
Case "Owner": Cells(ThisR, 8).Value = Trimmed(.Cells(lngJ, 3).Value)
Case "Co-owned": Cells(ThisR, 9).Value = Trimmed(.Cells(lngJ, 3).Value)
Case "Website": Cells(ThisR, 10).Value = Trimmed(.Cells(lngJ, 3).Value)
Case "Began Operation": Cells(ThisR, 11).Value = Trimmed(.Cells(lngJ, 3).Value)
Case "Facilities": Cells(ThisR, 12).Value = Trimmed(.Cells(lngJ, 3).Value)
Case "Transmitter": Cells(ThisR, 13).Value = Trimmed(.Cells(lngJ, 3).Value)
Case "History": Cells(ThisR, 14).Value = Trimmed(.Cells(lngJ, 3).Value)
Case "App": Cells(ThisR, 15).Value = Trimmed(.Cells(lngJ, 3).Value)
End Select
End With

Next lngJ

Columns("a:j").EntireColumn.AutoFit
'Worksheets("Output").Range("A1").Sort Key1:=Worksheets("Output").Columns("A"), Header:=xlGuess
Call Do_Next

Application.ScreenUpdating = True

End Sub

Private Function Trimmed(val As String)
Dim i As Long

val = Replace(val, Chr(160), " ")
val = Trim(val)
Trimmed = val
End Function
[/vba]

[parttime_guy]

Greetings Xld,

Thx for taking interest in this post.

Just a reminder James, plz use xld's code with "VBAExpress_Transform_100K_solution.xls" the first attachment.

I have removed "Sub Do_Next" in my second attachment. Hope u take note of this changes James.

Best Regards

[James Niven]

Thanks to both of you for your efforts put forward.

Parttime_Guy: Your code does the job I have asked. I am not sure if there is an issue which I have recently discovered. I run Excel 2007 here on my home computer and I have found the Sub Do_Next part of your runs OK until it gets to the second section if you will where you mention doing the auto filter. It runs all the code and for some reason, all the lines of converted data get deleted and only the first line remains. I run the same code on my work Laptop which also runs Excel 2007 and it runs fine without any isse.

Oh, and be the way, forgot to mention there are W and C calls along with the K calls as well.

XLD: Your code runs fine as for the trimming spaces, not sure what the issue is with the Do_Next module as stated above.

Thanks to you all, this is a learning experience indeed.

James

[parttime_guy]

Hi James,

If you go through XLD's code you may realise that that there are some lines in the code eg

Columns("a:j").EntireColumn.AutoFit
'Worksheets("Output").Range("A1").Sort Key1:=Worksheets("Output").Columns("A"), Header:=xlGuess
Call Do_Next

I had created a new sub "Sub Do_Next" in the first attachment.

XLD created a new code to "Trim" all the spaces which will work only on the first attachment. This code also uses sub Do_Next.

-----
Now comming to the second attachment.

After doing some changes I deleted the sub Do_Next in the second attachment and incorporated the the codes related to Do_Next directly into your sub parseMeters.

-----
Conculsion

Please do not XLD's code on the second attachment as this does not have the sub Do_Next.

If you are trying to test XLD's code, plz test it on the first attachment, this has the sub Do_Next so it will not give you an error (and, It also works faster).

James, to clear the air, plz check the new file attached, which has XLD's code incorporated in it.

Hope this clarifies....

Best regards

[James Niven]

Parttime_Guy,

I understand what you are saying and have followed your steps but I seeme to get the same error of the lines of converted data deleting when you Do_next code runs. I have isolated this piece of the code that is causing the issue.

'----- I hope all ur call signs start with "K"

'Selection.AutoFilter Field:=1, Criteria1:="<>k*", Operator:=xlAnd
'Range("A4").Select
'Range(Selection, Selection.End(xlDown)).Select
'Range(Selection, Selection.End(xlDown)).Select
'Rows("4:65536").Select
'Selection.Delete Shift:=xlUp
'Range("A1").Select
'ActiveSheet.ShowAllData
End Sub

Like I mentioned in my reply not too sure if its Excel 2007 having the issue or what is may be.

Thanks

[Bob Phillips]

Why doesn't the OP post the workbook he is now working on, I am confused as to which one is erroring for him.

[James Niven]

XLD,

Sorry, you are right.

Here is the spreadsheet attached which I am having issues with. It seems to be the Do-Next section where is issue lies.

This is the section
----- I hope all ur call signs start with "K"

'Selection.AutoFilter Field:=1, Criteria1:="<>k*", Operator:=xlAnd
'Range("A4").Select
'Range(Selection, Selection.End(xlDown)).Select
'Range(Selection, Selection.End(xlDown)).Select
'Rows("4:65536").Select
'Selection.Delete Shift:=xlUp
'Range("A1").Select
'ActiveSheet.ShowAllData
End Sub
As you can see I have this disabled in the code. If its enable all the lines of converted data delete and I am left with the first line only.
As you see on the Output page these are the results I get.

I hope this helps.

James

[Bob Phillips]

I am not seeing it James. Do-Next is not commented out, but I am getting all the data rows not just one.

[James Niven]

XLD,

May be not in the example I posted that you will see the lines of code commented out, but this is my work around for now.

Thanks for looking, at least I know that the code worked no problem for you and I am following Parttime_Guy's instruction pretty well.

I appreicate your input to my project, trimming the data has helped me considerly.

Thanks

James