Filtering info to corresponding sheet

  • Thread starter Thread starter JC
  • Start date Start date
J

JC

I have one workbook with 15 sheets, One sheet is a master list of contacts
and the other 14 represent regions in the U.S. that each of the contacts on
the master sheet list can be classified in. I am new to Visual Basic but am
trying to develop a function that will place the contacts in their
corresponding sheets and also have excel automatically update the
corresponding sheets in the future when a new contact is added to the master
list. Any suggestion? Thank you
 
Seems kind of vague. Can you give ONE specific example of wht you would like
to do.

Thanks,
Ryan---
 
Ryan thanks for the speedy response let me try to break it down some more:

For example, I have a contact with a name, address, region, and email

I would like to place this contact and their info in a ws that is only for
contacts in their region.

I need excel to pull from a large list of these contacts and place in 14
different ws (each ws represents a diff region) and do it automatically when
a new contact is added to the large list. Hope this is more clear
Thanks
 
this may do what you want but suggest you visit Rn's site for further guidance.

I have assumed your Region data is in Col C - you will need to correct as
required.
Paste code in standard module - you can add a button to your master sheet to
run it.

Sub FilterRegionDataToSheets()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim lr As Integer
Dim c As Range

'worksheet where your data is stored
'change sheet name as required
Set ws1 = ThisWorkbook.Worksheets("Sheet1")

With ws1

lr = .Cells(.Rows.Count, "A").End(xlUp).Row


Set rng = .Range("A1:D" & lr)

'extract regions
.Columns("C:C").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("J1"), Unique:=True

lr = .Cells(.Rows.Count, "J").End(xlUp).Row

'set Criteria
.Range("L1").Value = .Range("C1").Value

For Each c In .Range("J2:J" & lr)
'add the name to the criteria area
.Range("L2").Value = c.Value

'sheet aleady exists
If SheetExists(c.Value) Then
Sheets(c.Value).Cells.Clear
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("L1:L2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
Unique:=False
Else
'add new sheet
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("L1:L2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If


Next

.Select
.Columns("J:L").Delete

End With
End Sub
 
sorry, pressed post too quickly, forgot to include the function!!

Sub FilterRegionDataToSheets()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim lr As Integer
Dim c As Range

'worksheet where your data is stored
'change sheet name as required
Set ws1 = ThisWorkbook.Worksheets("Sheet1")

With ws1

lr = .Cells(.Rows.Count, "A").End(xlUp).Row


Set rng = .Range("A1:D" & lr)

'extract regions
.Columns("C:C").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("J1"), Unique:=True

lr = .Cells(.Rows.Count, "J").End(xlUp).Row

'set Criteria
.Range("L1").Value = .Range("C1").Value

For Each c In .Range("J2:J" & lr)
'add the name to the criteria area
.Range("L2").Value = c.Value

'sheet aleady exists
If SheetExists(c.Value) Then
Sheets(c.Value).Cells.Clear
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("L1:L2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
Unique:=False
Else
'add new sheet
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("L1:L2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If


Next

.Select
.Columns("J:L").Delete

End With
End Sub

Function SheetExists(wksName As String) As Boolean
On Error Resume Next
SheetExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function
 
Thank you guys. Let me play around with all this and see if i can get it to
do what i want it to do
 
Note: I suggest that you not use the code that John posted

Read why on this page
http://www.rondebruin.nl/copy5.htm

Read this:
Do you wonder why I only use AdvancedFilter in the code to create the unique list and
not use xlFilterCopy to filter and copy the data to a new sheet or workbook ?
The reason why I use AutoFilter for that in the code is that there is a bug in xlFilterCopy
It will not copy the correct data when you have duplicate headers in the first row of your data.
Now with 16000+ columns in Excel 2007 the chance that this will happen is much bigger.




--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm
 
Hi Ron,
I am aware of that bug you describe but you may have noted in my first post
I did direct op to visit your site for “further guidanceâ€. However and in
this case, field range described seemed limited & headers all appear unique -
suggested code posted was as guidance and hopefully should, in this case,
work but if not, can be update as required.

many thanks
 
Hi John

Good that you know about the bug
But remember that Google newsgroup archive readers will read it also so that's why I add it to the thread

I only use xlFilterCopy on a single column to get the unique data but
stop using it with more columns because of this bug.

Have a nice day


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm
 
Ron

I used your copy to sheets example and it was very helpful. I am having
trouble getting it to finish without needing to debug.

The line that reads: Set My_Range = Range("A11:D" & LastRow(ActiveSheet))
Is the problem

I changed it to fit my sheet to : Set My_Range = Range("A1:I1" &
"A31:I31")(ActiveSheet)

I am not sure where I need to go with this. Some more incite is needed

Thank you
 
First cell header is A1
Last column is I

Also, I need to filter by column C

Thank you Ron you have been more than helpful

JC
 
Ron

Sorry to get back to the issue a little later. I tried the new info and when
i run the macro a dialog box comes up and highlights "LastRow" and says
"Compile error: Sub or Function not defined. I do not know which way to go on
this.

Thanks for your help

I am about to leave my office but if we could continue our dialog tommorrow
that would be helpful
 
Ron

I was able to get my worksheet to work. Thank You. I now have another task I
am trying to tackle. In the same workbook i would like to create a macro that
updates each of new sheets when a buttoned is clicked. The macro i am using
now (yours) will create error worksheets if run more than once. Any
suggesttions?
 
Yes.

I used the Copy worksheets 2 Mod and I changed the range to fit my workbook
as well as the field num to the column I wanted to sort by
 
Back
Top