VBA AdvancedFilter CopyToRange Missing Formats

Brockjava

New Member
Joined
Jan 28, 2014
Messages
5
Hello All,

I have successfully copied filtered data from one table to another with the code below.

What is missing is the formatting from the source table "Data". The VBA code will only copy and paste the values. I want both data and formatting.


  1. How do I retain the formatting from the source table/sheet?
    • If that is not possible a good work around would be to format the new copied data starting at cell A6. How do I do that? I would like to use the built in table styles in Excel 2007 like the banned rows ect.
  2. How do I create a hyperlink for the cells containing the IP?
    • Because the VBA code only copies the data, I have lost the hyperlinks I created in the source table.

Code:
Sub FilterData()
    Sheets("Search").Select
    Range("A6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Clear
    
    Sheets("Data").Range("Data[#All]").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Sheets("Criteria").Range("A1:D2"), CopyToRange:=Sheets("Search").Range("A6"), Unique:=True
    Columns.AutoFit
    Cells.WrapText = False
    Range("B1").Select
    Range("C4").Value = Range("A" & Rows.Count).End(xlUp).Row - 6 & " Records"
End Sub

Sample Output: Missing Format

QdevbPK.gif


NOTE: This VBA code is only for TESTING. This code copies data and the formatting from a table on the source sheet to the destination sheet successfully.

Code:
Sub CopyData()    Sheets("Data").Range("Data[#All]").Copy _
    Destination:=Sheets("Search").Range("A6")
End Sub

Sample Output: Format Copied

Wcqbabe.gif


Any help would be much appreciated.

Thank you!
Using Excel 2007
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Hi Brockjava,

the formatting you see is due to the fact that the range is defined as a table. So the only thing you have to do after copying the data is defining the table, like so:

Code:
Sub FilterCopyTable()

Sheets("DATA").ListObjects("All").Range.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("DATA").Range("A1:B2"), CopyToRange:=Sheets("Sheet5").Range("A6"), Unique:=True
MaxRw = Sheets("Sheet5").Range("A" & Cells.Rows.Count).End(xlUp).Row
Sheets("Sheet5").ListObjects.Add(xlSrcRange, Sheets("Sheet5").Range("A6:C" & MaxRw), , xlYes).Name = "YourNewTable"

End Sub

I added a line to find the maximum column and my ranges are not the same as yours, but this should do the trick.

Kind regards,

Koen
 
Upvote 0
I added a line to find the maximum column and my ranges are not the same as yours, but this should do the trick.

Kind regards,

Koen

You are a genius! Thank you. This did the trick!

Now to my other question in the post above. How do I write the code to hyperlink the IP address in the "Host Address" column?

Code:
=HYPERLINK("http://"&C2,B2)

C2 = the IP
B2 = the label

When I add the code in the raw data table I can click the link in the raw data table. But when it copies the data over the search tab, it is just the value and not the hyperlink or formula.

I think the solution is to add code to insert a column in the table with the link formula or to wrap the IP in the formula. I don't know how to do that. Any thoughts?
 
Upvote 0
Hi Brockjava,

Something like this I think (got some code from recording a macro making a hyperlink):

Code:
For Rw = 6 to MaxRw
Sheets("Sheet5").Range("B" & Rw).Hyperlinks.Add Anchor:=Sheets("Sheet5").Range("B" & Rw), Address:="http://" & Sheets("Sheet5").Range("C" & Rw)
Next Rw

Recording is really helpful sometimes :),

Cheers,

Koen
 
Upvote 0
Hi Brockjava,

Something like this I think (got some code from recording a macro making a hyperlink):

Code:
For Rw = 6 to MaxRw
Sheets("Sheet5").Range("B" & Rw).Hyperlinks.Add Anchor:=Sheets("Sheet5").Range("B" & Rw), Address:="http://" & Sheets("Sheet5").Range("C" & Rw)
Next Rw

Recording is really helpful sometimes :),

Cheers,

Koen


Fails on:

Code:
Sheets("Search").Range("B" & Rw).Hyperlinks.Add Anchor:=Sheets("Search").Range("B" & Rw), Address:="http://" & Sheets("Search").Range("C" & Rw)
Not sure how to properly debug.
 
Upvote 0
This is what the macro spit out:

Code:
Sub AddLink()'
' AddLink Macro
'


'
    ActiveCell.FormulaR1C1 = _
        "=HYPERLINK(""http://""&Results[[#This Row],[Host Address]],Results[[#This Row],[Share Name]])"
    Range("J8").Select
End Sub

However this adds a column with the link, I would rather just add or wrap a formula around the data being copied.
 
Upvote 0
Hi Brockjava,

almost there, it took a bit of fiddling around, but this works on my PC:

Code:
Sheets("Sheet5").Hyperlinks.Add Anchor:=Sheets("Sheet5").Range("B" & Rw), Address:="http://" & Sheets("Sheet5").Range("C" & Rw).Value, TextToDisplay:=Sheets("Sheet5").Range("B" & Rw).Value

It has to do with the .Value part, I guess.

Cheers,

Koen
 
Upvote 0
Hi Brockjava,

almost there, it took a bit of fiddling around, but this works on my PC:

Code:
Sheets("Sheet5").Hyperlinks.Add Anchor:=Sheets("Sheet5").Range("B" & Rw), Address:="http://" & Sheets("Sheet5").Range("C" & Rw).Value, TextToDisplay:=Sheets("Sheet5").Range("B" & Rw).Value

It has to do with the .Value part, I guess.

Cheers,

Koen


That worked perfectly!!! Thank you very much Koen.
 
Upvote 0

Forum statistics

Threads
1,213,513
Messages
6,114,064
Members
448,545
Latest member
kj9

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top