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



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



Any help would be much appreciated.

Thank you!
Using Excel 2007
 

Rijnsent

Well-known Member
Joined
Oct 17, 2005
Messages
1,166
Office Version
365
Platform
Windows
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
 

Brockjava

New Member
Joined
Jan 28, 2014
Messages
5
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?
 

Rijnsent

Well-known Member
Joined
Oct 17, 2005
Messages
1,166
Office Version
365
Platform
Windows
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
 

Brockjava

New Member
Joined
Jan 28, 2014
Messages
5
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.
 

Brockjava

New Member
Joined
Jan 28, 2014
Messages
5
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.
 

Rijnsent

Well-known Member
Joined
Oct 17, 2005
Messages
1,166
Office Version
365
Platform
Windows
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
 

Brockjava

New Member
Joined
Jan 28, 2014
Messages
5
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.
 

Forum statistics

Threads
1,085,307
Messages
5,382,856
Members
401,807
Latest member
xlWatcher

Some videos you may like

This Week's Hot Topics

Top