PDA

View Full Version : Solved: Looping through autofilter, copy, paste



lucky245
06-21-2010, 02:44 AM
The scenario for doing this is that I import data using a pivot table for a chart and I am using drop downs (combo box) to select which wards I want to find the data on. One combo box chooses a Section : Alpha, Bravo etc then this populates the second combo box with the ward I can choose.

As I have pre-populated my main table with every ward against every section the combo box currently holds every ward in that section, however the pivot table will only import data that is available and not all wards have populated the database yet. So I currently have a combo box with wards that have no data to display. And the list can contain up to 30 wards.

Problem:
The data is being imported from Ms Access which comes in True / False fields
What I need to do it autofilter each column 2 – 5 (Alpha – Delta) and then set each of these columns one by one to true, and copy the ward names from column 1 (Ward) into a new column in a worksheet named Data which will be a dynamic range. I want to do this using vb.

I can do the autofilter and copy each column although I am presently declaring the row numbers to copy. Pasting into the new worksheet (dynamic range) is my problem.

Rather than running the


set autofilter to true
copy ward names in column A
paste into column B (for example)
I would like to loop through these processes .

Example of data

Ward Alpha Bravo Charlie Delta
3B True False False True
7S False True False False
10N False False True True
6E False True True False

should end up as

Alpha Bravo Charlie Delta
3B 7S 10N 3B
6E 6E 10N

lucky245
06-21-2010, 12:06 PM
Problem solved with code below courtousy of PCI

Sub Copy_Data()
Dim OrgSh As String
Dim DestSh As String
Dim LastRow As Long
Dim MyRg As Range
Dim I As Integer
OrgSh = "Sheet1"
DestSh = "Sheet2"
Sheets(DestSh).Cells.ClearContents
With Sheets(OrgSh)
.Range("B1:E1").Copy Destination:=Sheets(DestSh).Cells(1, 1)
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set MyRg = .Range("A1").CurrentRegion
If (.AutoFilterMode) Then .AutoFilterMode = False ' REMOVE AUTOFILTER IF EXIST
For I = 2 To 5
MyRg.AutoFilter Field:=I, Criteria1:="TRUE"
.Range("A1:A" & LastRow).Offset(1, 0).Copy Destination:=Sheets(DestSh).Cells(2, I - 1)
MyRg.AutoFilter Field:=I
Next I
If (.AutoFilterMode) Then .AutoFilterMode = False ' REMOVE AUTOFILTER IF EXIST
End With
End Sub
]