Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Feed List of Names into Ron de Bruin Code-Filter
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:D" & 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 cant 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--- -- RyGuy |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Feed List of Names into Ron de Bruin Code-Filter
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--- -- RyGuy "ryguy7272" wrote: 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:D" & 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 cant 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--- -- RyGuy |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Feed List of Names into Ron de Bruin Code-Filter
Hi ryguy7272
Try this Change this ' Add a worksheet to copy the a unique list and add the CriteriaRange Set ws2 = Worksheets.Add To Set ws2 = Worksheets("yoursheetnamewith the list") Delete this part 'first we copy the Unique data from the filter field to ws2 rng.Columns(FieldNum).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("A1"), Unique:=True 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 'Delete the ws2 sheet On Error Resume Next Application.DisplayAlerts = False .Delete Application.DisplayAlerts = True On Error GoTo 0 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ryguy7272" wrote in message ... 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--- -- RyGuy "ryguy7272" wrote: 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:D" & 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 cant 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--- -- RyGuy |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Feed List of Names into Ron de Bruin Code-Filter
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--- -- RyGuy "Ron de Bruin" wrote: Hi ryguy7272 Try this Change this ' Add a worksheet to copy the a unique list and add the CriteriaRange Set ws2 = Worksheets.Add To Set ws2 = Worksheets("yoursheetnamewith the list") Delete this part 'first we copy the Unique data from the filter field to ws2 rng.Columns(FieldNum).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("A1"), Unique:=True 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 'Delete the ws2 sheet On Error Resume Next Application.DisplayAlerts = False .Delete Application.DisplayAlerts = True On Error GoTo 0 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ryguy7272" wrote in message ... 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--- -- RyGuy "ryguy7272" wrote: 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:D" & 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 cant 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--- -- RyGuy |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Feed List of Names into Ron de Bruin Code-Filter
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--- -- RyGuy "ryguy7272" wrote: 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--- -- RyGuy "Ron de Bruin" wrote: Hi ryguy7272 Try this Change this ' Add a worksheet to copy the a unique list and add the CriteriaRange Set ws2 = Worksheets.Add To Set ws2 = Worksheets("yoursheetnamewith the list") Delete this part 'first we copy the Unique data from the filter field to ws2 rng.Columns(FieldNum).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("A1"), Unique:=True 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 'Delete the ws2 sheet On Error Resume Next Application.DisplayAlerts = False .Delete Application.DisplayAlerts = True On Error GoTo 0 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ryguy7272" wrote in message ... 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--- -- RyGuy "ryguy7272" wrote: 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:D" & 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 cant 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--- -- RyGuy |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Feed List of Names into Ron de Bruin Code-Filter
I reply to your private mail
-- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ryguy7272" wrote in message ... 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--- -- RyGuy "ryguy7272" wrote: 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--- -- RyGuy "Ron de Bruin" wrote: Hi ryguy7272 Try this Change this ' Add a worksheet to copy the a unique list and add the CriteriaRange Set ws2 = Worksheets.Add To Set ws2 = Worksheets("yoursheetnamewith the list") Delete this part 'first we copy the Unique data from the filter field to ws2 rng.Columns(FieldNum).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("A1"), Unique:=True 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 'Delete the ws2 sheet On Error Resume Next Application.DisplayAlerts = False .Delete Application.DisplayAlerts = True On Error GoTo 0 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ryguy7272" wrote in message ... 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--- -- RyGuy "ryguy7272" wrote: 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:D" & 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 cant 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--- -- RyGuy |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Feed List of Names into Ron de Bruin Code-Filter
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("A1:D100").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--- -- RyGuy "Ron de Bruin" wrote: I reply to your private mail -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ryguy7272" wrote in message ... 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--- -- RyGuy "ryguy7272" wrote: 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--- -- RyGuy "Ron de Bruin" wrote: Hi ryguy7272 Try this Change this ' Add a worksheet to copy the a unique list and add the CriteriaRange Set ws2 = Worksheets.Add To Set ws2 = Worksheets("yoursheetnamewith the list") Delete this part 'first we copy the Unique data from the filter field to ws2 rng.Columns(FieldNum).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("A1"), Unique:=True 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 'Delete the ws2 sheet On Error Resume Next Application.DisplayAlerts = False .Delete Application.DisplayAlerts = True On Error GoTo 0 -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ryguy7272" wrote in message ... 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--- -- RyGuy "ryguy7272" wrote: 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:D" & 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 cant 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--- -- RyGuy |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Can you Filter using names from a generated list??? | Excel Programming | |||
Triple Filter? Ron de Bruin Code. | Excel Programming | |||
Filter a list of names! | Excel Discussion (Misc queries) | |||
How do I create/filter a list of names without duplications | Excel Discussion (Misc queries) | |||
filter 400 names from list 1 from list 2 with 4000 names | Excel Worksheet Functions |