Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
How do I delete blank rows (rows alternate data, blank, data, etc | Excel Discussion (Misc queries) | |||
Advancedfilter returning all rows instead of ones that match crit | Excel Programming | |||
Delete blank row only if 2 consecutive blank rows | Excel Programming | |||
Copying and pasting a worksheet to a blank and removing blank rows | Excel Programming | |||
How to count rows in a user-defined AutoFilter or AdvancedFilter is active? | Excel Programming |