Filtering info to corresponding sheet

[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

 

[ryguy7272]

Seems kind of vague. Can you give ONE specific example of wht you would like
to do.

Thanks,
Ryan---

 

[Ron de Bruin]

Maybe ?
http://www.rondebruin.nl/copy5_5.htm

--

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

 

[JC]

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

 

[ryguy7272]

Look at Ron's link (Ron is beyond Excel Guru level). Also, look here for a
sample that uses functions rather than VBA code:
http://www.savefile.com/files/2152727

HTH,
Ryan---

 

[john]

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" & 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

 

[john]

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" & 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

 

[JC]

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

 

[Ron de Bruin]

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

 

[john]

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

 

[Ron de Bruin]

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

 

[JC]

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" & 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

 

[Ron de Bruin]

Hi JC

What is the cell address of the header of the first column ?
What is the last column with data in your data table ?

--

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

 

[JC]

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 de Bruin]

Hi JC

Then use

Set My_Range = Range("A1:I" & LastRow(ActiveSheet))

And use this for column C, because your data start in A, C is the third column.

FieldNum = 3



--

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

 

[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 de Bruin]

You forgot to copy the lastrow function in your code module

--

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

 

[JC]

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?

 

[Ron de Bruin]

Do you use the code from this page ?
http://www.rondebruin.nl/copy5_5.htm

--

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

 

[JC]

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