VBA AdvancedFilter CopyToRange Missing Formats

[Brockjava]

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.

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

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.

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

Sample Output: Format Copied

Any help would be much appreciated.

Thank you!
Using Excel 2007

 

[Rijnsent]

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:

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

 

[Brockjava]

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?

=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?

 

[Rijnsent]

Hi Brockjava,

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

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

 

[Brockjava]

Hi Brockjava,

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

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:

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.

 

[Brockjava]

This is what the macro spit out:

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.

 

[Rijnsent]

Hi Brockjava,

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

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

 

[Brockjava]

Hi Brockjava,

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

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.