Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 126
Default AdvancedFilter with Blank Rows - Any Help

I'm not sure what you mean the unique records based on 3 columns.
so, this is not what you want, but this one would show only data in
which a result of combination of column C, D, E is the unique.

Sub GetUnique()
Dim trng As Range, afrng As Range
Dim tmprng As Range, ctrng As Range
Dim strc As Long, ltrc As Long
Dim stlc As Long, ltlc As Long
Dim strads As String
Dim i As Long, co As Long

On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0

Set trng = ActiveCell
Set afrng = trng.CurrentRegion
If afrng.Count = 1 Or IsEmpty(trng) Then
MsgBox "Select a cell in the Table"
Exit Sub
End If
strc = afrng.Row
ltrc = afrng.Rows.Count + strc - 1
stlc = afrng.Column
ltlc = afrng.Columns.Count + stlc - 1
co = Cells(strc, Cells.Columns.Count) _
.End(xlToLeft).Column
Columns(co + 1).Resize(, Cells.Columns.Count - co) _
.Delete
Set trng = Cells(strc, trng.Column)
If Cells(strc, ltlc).Value = "CTEMP" Then
MsgBox "Delete Temporary columns"
Exit Sub
End If
Set tmprng = Cells(strc, ltlc + 1)
tmprng.Value = "CTEMP"
For i = 2 To ltrc - strc + 1
tmprng(i, 1) = Cells(i, "C") & Chr(5) _
& Cells(i, "D") & Chr(5) _
& Cells(i, "E") '<<===Change here
Next
strads = Range(tmprng(2, 1), _
tmprng(ltrc - strc + 1, 1)).Address
Set afrng = Range(tmprng, Cells(ltrc, ltlc + 1))
Set ctrng = Cells(strc, ltlc + 3)
ctrng(2, 1).Formula = "=countif(" & strads & "," & _
Cells(strc + 1, tmprng.Column) _
.AddressLocal(RowAbsolute:=False) & ")=1"
afrng.AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=ctrng.Resize(2, 1)
End Sub

keizi

"Bala" wrote in message
oups.com...
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


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How do I delete blank rows (rows alternate data, blank, data, etc ncochrax Excel Discussion (Misc queries) 2 June 27th 07 04:40 AM
AdvancedFilter with Blank Rows - Any Help Bala[_2_] Excel Programming 0 May 4th 06 06:07 AM
Advancedfilter returning all rows instead of ones that match crit jjfjr Excel Programming 8 July 13th 05 08:37 PM
Copying and pasting a worksheet to a blank and removing blank rows Bob Reynolds[_3_] Excel Programming 0 June 24th 04 02:55 PM
How to count rows in a user-defined AutoFilter or AdvancedFilter is active? Frank Krogh Excel Programming 1 February 26th 04 11:08 AM


All times are GMT +1. The time now is 08:59 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"