I am having an issue with looping through my advanced filter that loops through a data validation list then needs to copy each filtered data result into one sheet, one after another. I am able to get the data validation to loop through each drop down selection and filtered each persons results but it was copying and pasting the results into new workbooks for each drop down selection. So I was getting 15 new workbooks. I am not able to get it to paste into a sheet that I created in my workbook titled "Template" I can only get the first selection off the drop down list to paste in and then it errors out or stops. I am running the data validation list from a "Dashboard tab" that filters through an advanced filter criteria then populates the data in a table below the criteria range. This is the data that I need to copy and paste values into the template sheet for each person in the drop down list for the selected supervisor one below the other for one complete list. I only need the results copied from the range starting at B83 as I have the headers on my template sheet.
Is there a way to copy all results to one sheet. Do I need to clear out the filtered table result before it loops through the next person?
Sub SupLook()
'
' Looping Macro
'
Dim FName As String
FName = Sheets("Dashboard").Range("B80").Text
Dim FolderName As String
Dim inputRange As Range, r As Range, c As Range
Dim myDestWB As Workbook
Application.ScreenUpdating = False
'''' Open file dialog and choose folder
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = True Then
FolderName = .SelectedItems(1) & ""
Else
Exit Sub
End If
End With
'''' Location of DataValidation cell
Set r = Worksheets("Dashboard").Range("c80")
'''' Get DataValidation values
Set inputRange = Evaluate(r.Validation.Formula1)
'''' Loop through DataValidation list
For Each c In inputRange
r.Value = c.Value
FName = c.Value
'
Sheets("Details").Columns("A:Q").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("Dashboard!Supervisor"), CopyToRange:=Range("B82:k82"), _
Unique:=False
Range("B82:K82").Select
ActiveWorkbook.Worksheets("Dashboard").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Dashboard").Sort.SortFields.Add Key:=Range( _
"J83:J6215"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
ActiveWorkbook.Worksheets("Dashboard").Sort.SortFields.Add Key:=Range( _
"G83:G6215"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Dashboard").Sort.SortFields.Add Key:=Range( _
"F83:F6215"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Dashboard").Sort.SortFields.Add Key:=Range( _
"B83:B6215"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Dashboard").Sort
.SetRange Range("B82:K6215")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B83:K5000").Select
Selection.copy
Sheets("Template").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.Select
ActiveCell.SpecialCells(xlLastCell).Select
Range("A1").Select
ActiveWindow.SmallScroll Down:=45
ActiveCell.Offset(82, 1).Range("A1").Select
ActiveWindow.SmallScroll Down:=3
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.copy
Sheets.Add After:=ActiveSheet
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Sheets("Template").Select
Range("A82").Select
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveWindow.SmallScroll Down:=3
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.copy
Application.CutCopyMode = False
Next c
End Sub
Can you add a sample workbook, so we can see how the code is interacting with the worksheets?
There is a lot of code in there that is redundant from where the macro was recorded and it will be easier to see what is happing by stepping through the code
Purfleet
I was able to update my code a little and get the data to paste the first person selected perfectly into my template, but then the second person now is way down the sheet and off to the right like 9 columns. But the third person's results are directly under person two..
What do I need to update in the below code
Range("B83:K83").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.copy
Sheets("Template").Select
ActiveSheet.Paste
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(0, -9).Range("A1").Select
Sheets("Dashboard").Select
Range("B83:k50000").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-6
Selection.Clear
Jenn,
Please supply your workbook.
Regards
Phil
Is there a way to for me to supply my workbook through google drive or etc? It is too large to attach.
Hi Jenn,
I've sent you an email.
You could put the WB on Dropbox and link to it?
Regards
Phil