Solved: Need Help writing VBA

[DiamondNate]

I have a workbook I am trying to write a VBA for. My knowledge on the subject is slim but definitely pick things up quick. I have a workbook with 7 worksheets (US, EMEA, Asia, Oceania, Company Info, Traffic Data, Sponsorship Data)

I am trying to write a VBA for the following steps and specific to the worksheet. Any help would be greatly appreciated.

Traffic Data
1) Select All

2) Undo Merged columns

3) Undo Wrap Text

4) Highlight Coulmn B & Insert Column

5) Select column A than Text to Columns ':'

6) Find replace 'details' with nothing


Sponsorship Data
1) Select Column A

2) Undo Wrap Text, right align

3) Highlight Column B and Insert Column

4) Select column A

5) Text to Columns '('

6) Highlight Columns A & B

7) Ctl+H (Find Replace) - Find ), Replace with nothing

8) (Find Replace) - Find 'Pro AV Products | ' replace nothing

9) Sort 5-24, 30-49, 54-74, 80-99 by Column B than Column A

--------------------------------------------------------------------------
Here is what I have so far

Sub TrafficDataFormatt()
' TrafficDataFormatt Macro
Cells.Select
Selection.UnMerge
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=":", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Columns("B:B").Select
Selection.Replace What:="Details", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub

[Teeroy]

Below is a general cleanup of your first code which should help you for the second part.

Sub TrafficDataFormatt()
With Cells
.WrapText = False
.MergeCells = False
End With
Columns("B").Insert
Columns("A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=":", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Columns("B").Replace What:="Details", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub

[DiamondNate]

Here is what I have for the second part. I am having trouble with the sorts by row.
Sub SponsorshipData()
With Cells
.WrapText = False
.MergeCells = False
.HorizontalAlignment = xlLeft
End With
Columns("B").Insert
Columns("A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Columns("A").Replace What:="Pro AV Products | ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("B").Replace What:=")", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Workheets("Sponsorship Data").Rows("5:24").Sort Key1:=Worksheets("Sponsorship Data").Range("B"), _
Key2:=Worksheets("Sponsorship Data").Range("A")
Worksheets("Sponsorship Data").Rows("30:49").Sort Key1:=Worksheets("Sponsorship Data").Range("B"), _
Key2:=Worksheets("Sponsorship Data").Range("A")
Worksheets("Sponsorship Data").Rows("55:74").Sort Key1:=Worksheets("Sponsorship Data").Range("B"), _
Key2:=Worksheets("Sponsorship Data").Range("A")
Worksheets("Sponsorship Data").Rows("80:99").Sort Key1:=Worksheets("Sponsorship Data").Range("B"), _
Key2:=Worksheets("Sponsorship Data").Range("A")
Worksheets("Sponsorship Data").Rows("103:124").Sort Key1:=Worksheets("Sponsorship Data").Range("B"), _
Key2:=Worksheets("Sponsorship Data").Range("A")
End Sub

What do I need to put write in to be sure each part is run on a specific sheet of the workbook?

Also I have a URL for an image on "Comapny Info" sheet B1 where I would like the image of that URL to be pulled into "US" sheet H23. How can I write this in as well?

Thanks for all your help!

[Teeroy]

Your attempt was pretty close to working but you'd asked for Ranges and were identifying columns. Try this. I've used a With block to contain the code to the sheet as you'd asked as well as reduce the repetition in the code.

Sub SponsorshipData()
With Worksheets("Sponsorship Data")
With .Cells
.WrapText = False
.MergeCells = False
.HorizontalAlignment = xlLeft
End With
.Columns("B").insert
.Columns("A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
.Columns("A").Replace What:="Pro AV Products | ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Columns("B").Replace What:=")", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Rows("5:24").Sort Key1:=.Columns("B"), Key2:=.Columns("A")
.Rows("30:49").Sort Key1:=.Columns("B"), Key2:=.Columns("A")
.Rows("55:74").Sort Key1:=.Columns("B"), Key2:=.Columns("A")
.Rows("80:99").Sort Key1:=.Columns("B"), Key2:=.Columns("A")
.Rows("103:124").Sort Key1:=.Columns("B"), Key2:=.Columns("A")
End With
End Sub
I can't easily answer the question about inserting the image as it depends on what version of excel you are running.

[DiamondNate]

Thank you so much for all your help! Definitely in the learning phase but am beginning to understand processes.

I am running excel 2007

Also the sort in your VBA above for the second part is not performing how I thought. My goal is to sort the rows first by B column than by A column. Just doesn't seem to be sorting it at all.

[Teeroy]

It should default to an ascending sort. I'll have a look at it later and get back to you.

[Teeroy]

Sorry DiamondNate, I took the Sort from excel 2003 code without thinking. Sort changed drastically in excel 2007. See how the code below works for you.

Sub SponsorshipData()
With Worksheets("Sponsorship Data")
With .Cells
.WrapText = False
.MergeCells = False
.HorizontalAlignment = xlLeft
End With
.Columns("B").Insert
.Columns("A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
.Columns("A").Replace What:="Pro AV Products | ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Columns("B").Replace What:=")", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'First Sort
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Columns("A"), SortOn:=xlSortOnValues, Order:=xlAscending
.Sort.SortFields.Add Key:=.Columns("B"), SortOn:=xlSortOnValues, Order:=xlAscending
.Sort.Header = xlGuess
.Sort.SetRange .Rows("5:24")
.Sort.Apply
'second sort
.Sort.SetRange .Rows("30:49")
.Sort.Apply
'third sort
.Sort.SetRange .Rows("55:74")
.Sort.Apply
'fourth sort
.Sort.SetRange .Rows("80:99")
.Sort.Apply
'fifth sort
.Sort.SetRange .Rows("103:124")
.Sort.Apply
End With
End Sub

[DiamondNate]

Teeroy,

Thanks for all your help. VBA worked like a charm. Couple questions.
1) If I would like to hide these cells, i.e. 5:24, that are being sorted what do I need to write in to be sure even hidden cells are sorted?

2) Been playing around with the image URL and getting the image pulled in and am not having much success. Any insight you could provide would be great.

Thanks!

[Teeroy]

I don't think you can include hidden rows in a sort (but I haven't needed to). I'd suggest the following steps would achieve the result:

format the hidden rows with a color (.interior.colorindex = 4 say)
unhide the rows
sort the sheet
find the rows with the formatting and re-hide them
remove the formatting.
As to the image import start another thread with a more specific title. There are lots of members here who can help but a lot of them will be put off by vague headings/descriptions.

[DiamondNate]

Teeroy,

Hiding the rows isn't a huge deal but I may play around to see what I am able to accomplish.

I greatly appreciate your help. Thanks!

[DiamondNate]

Hey again Teeroy,

Running into a little trouble when I am combining the two strings of code. Here is what I have and for whatever reason when I run this it never starts on teh Traffic Data worksheet and I get errors but when seperate on each tab they work just fine. Any pointers.

Sub test()
With Worksheets("Traffic Data")
With Cells
.WrapText = False
.MergeCells = False
End With
Rows("34:56").EntireRow.Hidden = False
Rows("92:114").EntireRow.Hidden = False
Rows("150:172").EntireRow.Hidden = False
Rows("208:230").EntireRow.Hidden = False
Columns("B").Insert
Columns("A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=":", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Columns("B").Replace What:="Details", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Rows("34:56").EntireRow.Hidden = True
Rows("92:114").EntireRow.Hidden = True
Rows("150:172").EntireRow.Hidden = True
Rows("208:230").EntireRow.Hidden = True
End With
With Worksheets("Sponsorship Data")
With .Cells
.WrapText = False
.MergeCells = False
.HorizontalAlignment = xlLeft
End With
.Columns("B").Insert
.Columns("A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
.Columns("A").Replace What:="Pro AV Products | ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Columns("B").Replace What:=")", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Rows("5:24").Sort Key1:=.Columns("B"), Key2:=.Columns("A")
.Rows("30:49").Sort Key1:=.Columns("B"), Key2:=.Columns("A")
.Rows("55:74").Sort Key1:=.Columns("B"), Key2:=.Columns("A")
.Rows("80:99").Sort Key1:=.Columns("B"), Key2:=.Columns("A")
.Rows("103:124").Sort Key1:=.Columns("B"), Key2:=.Columns("A")
End With
End Sub

[Teeroy]

What I can tell you is that in the first With block you haven't referenced back to the sheet. Cells should be .Cells, Rows should be .Rows and so on for every Range type object or collection. Without this reference the parent object would default to the ActiveSheet.

I'm on leave for couple of weeks so I can't test this to suit the sort on excel2007+ (I've only got 2003 at home).

[DiamondNate]

Teeroy thanks for the quick response. Just tested after placing .cells and .rows and everything works like a charm.

Thanks again for all your help.

[Teeroy]

You are welcome.

[DiamondNate]

Ok Teeroy,

One more thing I need to ask since I cannot seem to find an answer. Let's say I have some text hyperlinked to a website in worksheet 'Sponoship Data' A5 and I want to carry that hyperlink and text to worksheet'US' A93

Is this something that can be done?

[Teeroy]

I hadn't done this and I just found out that this can be a real pain in the ... I would suggest copy and paste of the cell as the easiest option. If you need to use the hyperlink object a simple code to help with the syntax is
Sub test()
ActiveSheet.Hyperlinks.Add Anchor:=Range("A7"), _
Address:=Range("A1").Hyperlinks(1).Address, TextToDisplay:=Range("A1").Value
End Sub

[DiamondNate]

Teeroy,

Again I appreciate your help.

What if I was to insert another column and separate the text and hyperlink. Then I could just use a formula to join them where I need them. Is this something that could be put into code?

This is only happening on Sponsorship Data worksheet. Could insert a column next to A. Have the hyperlink appear in the new inserted column.

I know that I can use the below code and in column B type =HyperLinkText(A1) but am having difficulty writing the code for it.

Dim ST1 As String
Dim ST2 As String
If pRange.Hyperlinks.Count = 0 Then
Exit Function
End If
ST1 = pRange.Hyperlinks(1).Address
ST2 = pRange.Hyperlinks(1).SubAddress
If ST2 <> "" Then
ST1 = "[" & ST1 & "]" & ST2
End If
HyperLinkText = ST1


Any help is greatly appreciated, thanks!

[Teeroy]

I'm not sure I completely understand exactly what you want but it appears you are trying to use a User Defined Function (UDF). Your code works but needs to be defined as a function in a standard module to operate as a UDF i.e.
Function HyperLinkText(pRange As Range)
Dim ST1 As String
Dim ST2 As String
If pRange.Hyperlinks.Count = 0 Then
Exit Function
End If
ST1 = pRange.Hyperlinks(1).Address
ST2 = pRange.Hyperlinks(1).SubAddress
If ST2 <> "" Then
ST1 = "[" & ST1 & "]" & ST2
End If
HyperLinkText = ST1
End Function

You could re-create a hyperlink with the formula =HYPERLINK(HyperLinkText(A1)).

I hope this helps.

[DiamondNate]

Teeroy,

You help has been greatly appreciated. I was hoping you would be able to help me one more time.

Trying to take a range of cells in a column and do a text to column with that range. There could be up to 8 in one array but that will vary. I can get the code to work for the active selected sheet be when I start adding with worksheet to the beginning I am getting errors. Can you show me where I am going wrong, thanks!

Sub test()
With Worksheets("Company Info")
.Range("B42:B68").Select
.Selection.TextToColumns Destination:=Range("B42"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
End With
End Sub

[Teeroy]

Selection should not have started with a "." as it isn't referred back to the worksheet. Apart from this, selecting the range is not required; it's just how the macro recorder shows the steps that you've taken while it was recording. The trick is knowing what you can change, but that comes from experience (and trial and error :) ).
Also Range("B42") in the destination should have had a "." otherwise it will probably default to the activesheet.

Try the following.

Sub test()
With Worksheets("Company Info")
.Range("B42:B68").TextToColumns Destination:=.Range("B42"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
End With
End Sub