Feed List of Names into Ron de Bruin Code-Filter

[ryguy7272]

The Macro below works great!
Sub CopyToNewSheet()
Sheets("Summary Sheet").Select 'Change to suit
Cells.Select
Selection.ClearContents
Dim myrange, copyrange As Range
Sheets("Goals-Copy").Select

Set myrange = Range("E2:E300")
For Each C In myrange
If C.Value <> "" Then
If copyrange Is Nothing Then
Set copyrange = C.EntireRow
Else
Set copyrange = Union(copyrange, C.EntireRow)
End If
End If
Next
copyrange.Copy
Sheets("Summary Sheet").Select 'Change to suit
Cells(1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
End Sub

It selects a sheet named ‘Goals-Copy’ and copies/pastes all items, that I
mark with an X, into a new sheet, named ‘Summary Sheet’.

This is the issue...I would like to take these results, which are basically
a list of names, in Column B, and run through the list to use each value in a
filter, which I got from the Ron de Bruin site.

Below is the Rob de Bruin code that I am trying to use:
Sub Copy_To_Worksheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim FieldNum As Integer

'Name of the sheet with your data
Set ws1 = Sheets("Summary Sheet") '<<< Change

'Set filter range : A1 is the top left cell of your filter range and
'the header of the first column, D is the last column in the filter range
Set rng = ws1.Range("A1" & Rows.Count)

'Set Field number of the filter column
'This example filters on the first field in the range(change the field
if needed)
'In this case the range starts in A so Field:=1 is column A, 2 = column
B, ......
FieldNum = 2 ‘This will correspond to the B Column in the Sheet named
("Summary Sheet")

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

' Add a worksheet to copy the a unique list and add the CriteriaRange
Set ws2 = Worksheets.Add

With ws2
'first we copy the Unique data from the filter field to ws2
rng.Columns(FieldNum).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("A1"), Unique:=True

'loop through the unique list in ws2 and filter/copy to a new sheet
Lrow = .Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In .Range("A2:A" & Lrow)

Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number > 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0

'Firstly, remove the AutoFilter
ws1.AutoFilterMode = False

'Filter the range
rng.AutoFilter Field:=FieldNum, Criteria1:="=" & cell.Value ‘<
-- this has to receive data from the list of names from the B Column in the
Sheet named ("Summary Sheet"). This is the part that I can’t figure out

'Copy the visible data and use PasteSpecial to paste to the new
worksheet
ws1.AutoFilter.Range.Copy
With WSNew.Range("A1")
' Paste:=8 will copy the columnwidth in Excel 2000 and higher
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With

'Close AutoFilter
ws1.AutoFilterMode = False

Next cell

'Delete the ws2 sheet
On Error Resume Next
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
On Error GoTo 0

End With

With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub


Finally, how would I copy/paste the list of names under previous
copied/pasted names, rather than copying/pasting to a new sheet? It may be
easily done with a simple For...Next loop. I've been using VBA for a little
while now, but I'm still not good with not good with these For...Next loops
so I'd greatly appreciate any help!

Thanks so much,
Ryan---

 

[ryguy7272]

I'm thinking that it has to be something like this:

Sheets("Summary Sheet").Range("B1").AutoFilter Field:=2, Criteria1:="=" &
cell.Value

The data that I am checking is on "Summary Sheet", but somehow there
variables have to be passed to the Sheet named "Master Consolidated
Mappings", because that's where all the data is stored...the criteria that I
want to filter for are on the "Summary Sheet".

If anyone has any insight into this, please share.

Regards,
Ryan---

 

[Ron de Bruin]

Hi ryguy7272

Try this

Change this


To

Set ws2 = Worksheets("yoursheetnamewith the list")


Delete this part


Change the range in this part to your range (I believe column B for you)

'loop through the list in ws2 and filter/copy to a new sheet
Lrow = .Cells(Rows.Count, "B").End(xlUp).Row
For Each cell In .Range("B2:B" & Lrow)


Delet this part

 

[ryguy7272]

Thanks Ron! Pretty amazing stuff, however it is still not doing what I was
hoping it would do. Basically, I have a list of names in a sheet named
'Summary Sheet'. I wanted to take each of these names and feed them into a
the filter which is on a sheet named 'Master Consolidated Mappings'. That's
the tricky part. I have dozens of names listed in 'Master Consolidated
Mappings' and I wanted to filter for three, Beth, Lee, and Jay...all listed
on my 'Summary Sheet'. I wanted to filter for these three names on the
'Master Consolidated Mappings' sheet, because all relevant information is
listed there. Does that make sense? Maybe there is an easier way of doing
this... I'm pretty sure it can be done...just not sure how to pull it off.
So far I haven't been able to figure it out. If I get it, I'll post back
with the solution... I'm pretty sure an MVP can figure it out.

Thanks,
Ryan---

 

[ryguy7272]

Disregard that last post; I wasn't paying attention at all. Try this:
Sub CopyToNewSheet()
Sheets("Report").Select 'Change to suit
Cells.Select
Selection.ClearContents
Dim myrange, copyrange As Range
Sheets("Report Data").Select
Set myrange = Range("F1:F300")
For Each C In myrange
If C.Value <> "" Then
If copyrange Is Nothing Then
Set copyrange = C.EntireRow
Else
Set copyrange = Union(copyrange, C.EntireRow)
End If
End If
Next
copyrange.Copy
Sheets("Report").Select 'Change to suit
Cells(1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
End Sub

This assumes that your data is on a sheet named "Report Data". You place a
"X" in Column F of the rows that you want to copy/paste to a sheet named
"Report". For the 'Hide colums D thru AE and AI, totaling Colums AF, AG and
AH' stuff, just turn on the macro recorder, run through the steps that you
need to do, and turn off the macro recorder. Get the cod, copy/paste to the
end of this code that I am giving you (but before the End Sub part). That
should get you pretty close to where you want to be.

Regards,
Ryan---

 

[Ron de Bruin]

I reply to your private mail

 

[ryguy7272]

The issue was complex to describe, and much more complex to solve.
Basically, I wanted to run the macro in sheet named 'Goals-Copy'. Some of
the rows, have an ‘x’, in column E, which indicate 'changes' in an
individual's goals (sales goals). If there is an ‘x’ in column E, when the
macro runs and a filter is applied to the items, in column C, on a sheet
named 'Master Consolidated Mappings'. Finally, I wanted to copy/paste the
entire row of the filtered list to a new sheet, named 'Filtered List';
appending the next group below the prior group.

Don was gracious enough to supply me with a solution, which is shown below:
Sub test()
Dim myrange As Range
Dim cell As Range

'clear filtered sheet
Sheets("Filtered List").Cells.Clear

'set range with a x
Set myrange = Sheets("Goals-Copy").Range("E2:E30")

'Filter/copy for every name value in the x row
For Each cell In myrange
If LCase(cell.Value) = "x" Then
With Sheets("Master Consolidated Mappings")
.AutoFilterMode = False
.Range("A1100").AutoFilter Field:=3, Criteria1:="=" &
cell.Offset(0, -3).Value


'Copy the visible data and use PasteSpecial to paste
.AutoFilter.Range.Copy
.AutoFilterMode = False
End With

With Sheets("Filtered List")
Lrow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Cells(Lrow, 1).PasteSpecial Paste:=8
.Cells(Lrow, 1).PasteSpecial xlPasteValues
.Cells(Lrow, 1).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Cells(Lrow, 1).EntireRow.Delete
.Select
.Cells(1).Select
End With

End If

Next cell

End Sub

Thanks for everything Ron!!!
Ryan---