AdvancedFilter with Blank Rows - Any Help
 

Hi,
Can anyone help for the following scenario?

I have an excel sheet in the following format,
where the cell values C8,D5,C10,D10 etc. are blank values(empty cell
values)

Sl No Name Age Place Mark
1 A 21 Place1 45
2 A 22 Place2 45
3 A 21 Place3 45
4 A 22 45
5 B 21 45
6 B 22 Place4 45
7 B Place3 45
8 B 22 Place2 45
9 C 21 48
10 C 45
11 C 21 45
12 C 22 47

I am doing out an advanced filter based on the Age, Place and Mark
columns (all the 3 columns) and getting the unique combination of
values in separate tabs in the same workbook.

But this advancedfilter method fails when it is finding out an empty
cell value. Instead of copying the unique row to the target tab it is
copying the whole data into the target tab. The macro code is as
follows.

Sub GetUniqueAndMoveToTab()
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
Dim cval As String, dval As String, eval As String

Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set rng = Range("Database") ' Database is the predefined Name for
the Range of data

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

ws1.Columns("E:E").AdvancedFilter action:=xlFilterCopy, _
COPYTORANGE:=Range("I1"), UNIQUE:=True
r3 = Cells(Rows.Count, "I").End(xlUp).Row

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

For Each c In ws1.Range("J2:J" & r1)
ws1.Range("L2").Value = c.Value

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

For Each e In ws1.Range("I2:I" & r3)
ws1.Range("N2").Value = e.Value

Set wsNew = Sheets.Add

If IsEmpty(c.Value) = True Then cval = "Blank" Else
cval = c.Value
If IsEmpty(d.Value) = True Then dval = "Blank" Else
dval = d.Value
If IsEmpty(e.Value) = True Then eval = "Blank" Else
eval = e.Value

titSheet = cval & "" & dval & "" & eval

wsNew.Move AFTER:=Worksheets(Worksheets.Count)
wsNew.Name = titSheet

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

Next e
Next d
Next c

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

End Sub

This is the code I have written for getting the unique records based on
3 columns and put into the new tabs.

Any Suggestions?

Thanx in Advance,
Regards,
Bala