Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
How do I delete blank rows (rows alternate data, blank, data, etc | Excel Discussion (Misc queries) | |||
AdvancedFilter with Blank Rows - Any Help | Excel Programming | |||
Advancedfilter returning all rows instead of ones that match crit | 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 |