Hi,
Can anyone give me solution for the following scenario?

I am a newbie in doing VBA Excel Macro development.

I have a scenario as Applying AdvancedFilter in more than one
columns and get the result based on this. The problem is it is working
for a single column and when I added for the second column the code
doesn't work.

Down here is the code.

Sub Sortit()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range

Dim r1 As Integer, r2 As Integer
Dim c As Range, d As Range

Dim titSheet As String

Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set rng = Range("Database")

ws1.Columns("C:C").AdvancedFilter action:=xlFilterCopy, _
COPYTORANGE:=Range("J1"), UNIQUE:=True
r1 = Cells(Rows.Count, "J").End(xlUp).Row

ws1.Columns("D:D").AdvancedFilter action:=xlFilterCopy, _
COPYTORANGE:=Range("K1"), UNIQUE:=True
r2 = Cells(Rows.Count, "K").End(xlUp).Row

Range("L1").Value = Range("C1").Value
Range("M1").Value = Range("D1").Value

For Each c In Range("J2:J" & r1)
ws1.Range("L2").Value = c.Value
For Each d In Range("K2:K" & r2)
ws1.Range("M2").Value = d.Value
Set wsNew = Sheets.Add
titSheet = c.Value & "" & d.Value
wsNew.Move AFTER:=Worksheets(Worksheets.Count)
wsNew.Name = titSheet
rng.AdvancedFilter action:=xlFilterCopy, _
criteriarange:=((Sheets("Sheet1").Range("L1:L2")) &
(Sheets("Sheet1").Range("M1:M2"))), _
COPYTORANGE:=wsNew.Range("A1"), UNIQUE:=False
Next d
Next c

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

End Sub

In this above C is the column with Age value(Numeric) and D is the
column with Place value(String). So basically I want to get m*n tabs
to be created if there are m unique age values and n unique place
values as the output.

Anyone help ?

Thanks in advance,
regards,
Bala

change

For Each d In Range("K2:K" & r2)

to

For Each d In ws1.Range("K2:K" & r2)

and for you last advanced filter, it should be:

rng.AdvancedFilter action:=xlFilterCopy, _
criteriarange:=Sheets("Sheet1").Range("L1:M2"), _
COPYTORANGE:=wsNew.Range("A1"), UNIQUE:=False

with those changes, it worked fine for me.

--
Regards,
Tom Ogilvy




"Bala" wrote:

Hi,
Can anyone give me solution for the following scenario?

I am a newbie in doing VBA Excel Macro development.

I have a scenario as Applying AdvancedFilter in more than one
columns and get the result based on this. The problem is it is working
for a single column and when I added for the second column the code
doesn't work.

Down here is the code.

Sub Sortit()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range

Dim r1 As Integer, r2 As Integer
Dim c As Range, d As Range

Dim titSheet As String

Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set rng = Range("Database")

ws1.Columns("C:C").AdvancedFilter action:=xlFilterCopy, _
COPYTORANGE:=Range("J1"), UNIQUE:=True
r1 = Cells(Rows.Count, "J").End(xlUp).Row

ws1.Columns("D:D").AdvancedFilter action:=xlFilterCopy, _
COPYTORANGE:=Range("K1"), UNIQUE:=True
r2 = Cells(Rows.Count, "K").End(xlUp).Row

Range("L1").Value = Range("C1").Value
Range("M1").Value = Range("D1").Value

For Each c In Range("J2:J" & r1)
ws1.Range("L2").Value = c.Value
For Each d In Range("K2:K" & r2)
ws1.Range("M2").Value = d.Value
Set wsNew = Sheets.Add
titSheet = c.Value & "" & d.Value
wsNew.Move AFTER:=Worksheets(Worksheets.Count)
wsNew.Name = titSheet
rng.AdvancedFilter action:=xlFilterCopy, _
criteriarange:=((Sheets("Sheet1").Range("L1:L2")) &
(Sheets("Sheet1").Range("M1:M2"))), _
COPYTORANGE:=wsNew.Range("A1"), UNIQUE:=False
Next d
Next c

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

End Sub

In this above C is the column with Age value(Numeric) and D is the
column with Place value(String). So basically I want to get m*n tabs
to be created if there are m unique age values and n unique place
values as the output.

Anyone help ?

Thanks in advance,
regards,
Bala