Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
delete entire row with condition
I would like to have a macro that scan a column (i.e. column a). Under the
scanned column, the entired row of any duplicate cell will be deleted. (i.e. cell a5=abc, cell a6, a7=abc, row a6 and a7 will be deleted). Anyone can give me a big hand? Thank you so much. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
delete entire row with condition
If the file is sorted on column A so that all duplicates are grouped, then:
Sub dups() Dim lr As Long, sh as Worksheet Set sh = ActiveSheet lr = sh.Cells(Rows.Count, 1).End(xlUp).Row For i = lr To 2 Step -1 If sh.Cells(i, 1) = sh.Cells(i - 1, 1) Then Rows(i).Delete End If Next End Sub The file m8ust be sorted first for the macro to work. "Anna" wrote in message ... I would like to have a macro that scan a column (i.e. column a). Under the scanned column, the entired row of any duplicate cell will be deleted. (i.e. cell a5=abc, cell a6, a7=abc, row a6 and a7 will be deleted). Anyone can give me a big hand? Thank you so much. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
delete entire row with condition
Hi Anna
Is the column sorted. The below macro will work even if ColA is sorted or not...Try and feedback Sub DeleteRows() Dim lngRow As Long For lngRow = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 If WorksheetFunction.CountIf(Columns(1), Range("A" & lngRow)) _ 1 Then Rows(lngRow).Delete Next End Sub If this post helps click Yes --------------- Jacob Skaria "Anna" wrote: I would like to have a macro that scan a column (i.e. column a). Under the scanned column, the entired row of any duplicate cell will be deleted. (i.e. cell a5=abc, cell a6, a7=abc, row a6 and a7 will be deleted). Anyone can give me a big hand? Thank you so much. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
delete entire row with condition
Your example is not entirely clear... what is in a6? Are you saying a5, a6
and a7 all have abc in them? If so, are you then saying to leave the duplicate in the lowest numbered row alone and to delete all the other duplicates' rows? -- Rick (MVP - Excel) "Anna" wrote in message ... I would like to have a macro that scan a column (i.e. column a). Under the scanned column, the entired row of any duplicate cell will be deleted. (i.e. cell a5=abc, cell a6, a7=abc, row a6 and a7 will be deleted). Anyone can give me a big hand? Thank you so much. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
delete entire row with condition
On 1 Ott, 08:01, Jacob Skaria
wrote: Hi Anna Is the column sorted. The below macro will work even if ColA is sorted or not...Try and feedback Sub DeleteRows() Dim lngRow As Long For lngRow = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 If WorksheetFunction.CountIf(Columns(1), Range("A" & lngRow)) _ 1 Then Rows(lngRow).Delete Next End Sub Too slow! In a sheet with 21759 rows but 9829 unique value it takes 244.9 seconds vs 49.5 seconds of Sub DeleteRows() by Jacob Skaria and vs 25.3 seconds of my sub DelRow(): '============================= Sub DelRow() ' by Scossa Dim rRng As Range Dim rCella As Range Dim nCnt1 As Long Dim nCol As Long Dim nCnt2 As Long Dim nLastR As Long Dim nStart As Double Dim xlcalc As XlCalculation With Application xlcalc = .Calculation .DisplayAlerts = False .ScreenUpdating = False .Calculation = xlCalculationManual .StatusBar = "working ... " End With nCol = Selection.Column nLastR = Cells(Rows.Count, nCol).End(xlUp).Row Set rRng = ActiveCell.Resize(nLastR, 1) With rRng nLastR = .Rows.Count nCnt2 = 0 Set rCella = .Cells(nLastR, 1) 'count start now nStart = Timer For nCnt1 = nLastR To 2 Step -1 If .Cells(nCnt1, 1) = .Cells(nCnt1 - 1, 1) Then nCnt2 = nCnt2 + 1 Set rCella = rCella.Offset(-1, 0) Else With rCella If nCnt2 0 Then .Offset(1, 0).Resize(nCnt2).EntireRow.Delete End If End With nCnt2 = 0 Set rCella = .Cells(nCnt1 - 1, 1) End If Next nCnt1 'count end now MsgBox "elapsed time: " & Timer - nStart End With rRng.Cells(1, 1).Select Application.ActiveWindow.ScrollRow = 1 Set rRng = Nothing Set rCella = Nothing With Application .DisplayAlerts = True .ScreenUpdating = True .Calculation = xlcalc .StatusBar = False End With End Sub '==================== Bye! Scossa |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
delete entire row with condition
Try setting Calculation to manual and disabling Alerts & Screen updating to
see 49.5 coming down.. If this post helps click Yes --------------- Jacob Skaria "Scossa" wrote: On 1 Ott, 08:01, Jacob Skaria wrote: Hi Anna Is the column sorted. The below macro will work even if ColA is sorted or not...Try and feedback Sub DeleteRows() Dim lngRow As Long For lngRow = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 If WorksheetFunction.CountIf(Columns(1), Range("A" & lngRow)) _ 1 Then Rows(lngRow).Delete Next End Sub Too slow! In a sheet with 21759 rows but 9829 unique value it takes 244.9 seconds vs 49.5 seconds of Sub DeleteRows() by Jacob Skaria and vs 25.3 seconds of my sub DelRow(): '============================= Sub DelRow() ' by Scossa Dim rRng As Range Dim rCella As Range Dim nCnt1 As Long Dim nCol As Long Dim nCnt2 As Long Dim nLastR As Long Dim nStart As Double Dim xlcalc As XlCalculation With Application xlcalc = .Calculation .DisplayAlerts = False .ScreenUpdating = False .Calculation = xlCalculationManual .StatusBar = "working ... " End With nCol = Selection.Column nLastR = Cells(Rows.Count, nCol).End(xlUp).Row Set rRng = ActiveCell.Resize(nLastR, 1) With rRng nLastR = .Rows.Count nCnt2 = 0 Set rCella = .Cells(nLastR, 1) 'count start now nStart = Timer For nCnt1 = nLastR To 2 Step -1 If .Cells(nCnt1, 1) = .Cells(nCnt1 - 1, 1) Then nCnt2 = nCnt2 + 1 Set rCella = rCella.Offset(-1, 0) Else With rCella If nCnt2 0 Then .Offset(1, 0).Resize(nCnt2).EntireRow.Delete End If End With nCnt2 = 0 Set rCella = .Cells(nCnt1 - 1, 1) End If Next nCnt1 'count end now MsgBox "elapsed time: " & Timer - nStart End With rRng.Cells(1, 1).Select Application.ActiveWindow.ScrollRow = 1 Set rRng = Nothing Set rCella = Nothing With Application .DisplayAlerts = True .ScreenUpdating = True .Calculation = xlcalc .StatusBar = False End With End Sub '==================== Bye! Scossa |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
delete entire row with condition
On 1 Ott, 13:41, Jacob Skaria
wrote: Try setting Calculation to manual and disabling Alerts & Screen updating to see 49.5 coming down.. Times (244.9 49.5 and 25.3) measured with this 3 sub modified and used for test: Sub DeleteRows() 'by Jacob Skaria Dim nStart As Double Dim lngRow As Long Dim nCol As Long Dim xlcalc As XlCalculation With Application xlcalc = .Calculation .DisplayAlerts = False .ScreenUpdating = False .Calculation = xlCalculationManual .StatusBar = "working ... " End With nCol = Selection.Column nStart = Timer For lngRow = Cells(Rows.Count, nCol).End(xlUp).Row To 1 Step -1 If WorksheetFunction.CountIf(Columns(nCol), Cells(lngRow, nCol)) _ 1 Then Rows(lngRow).Delete Next MsgBox "elapsed time: " & Timer - nStart Application.StatusBar = False With Application .DisplayAlerts = True .ScreenUpdating = True .Calculation = xlcalc .StatusBar = False End With End Sub Sub dups() ' by JLGWhiz Dim lr As Long, i As Long, sh As Worksheet Dim nCol As Long Dim nStart As Double Dim xlcalc As XlCalculation With Application xlcalc = .Calculation .DisplayAlerts = False .ScreenUpdating = False .Calculation = xlCalculationManual .StatusBar = "working ... " End With Set sh = ActiveSheet nCol = Selection.Column lr = sh.Cells(Rows.Count, nCol).End(xlUp).Row nStart = Timer For i = lr To 2 Step -1 If sh.Cells(i, nCol) = sh.Cells(i - 1, nCol) Then Rows(i).Delete End If Next MsgBox "elapsed time: " & Timer - nStart With Application .DisplayAlerts = True .ScreenUpdating = True .Calculation = xlcalc .StatusBar = False End With Set sh = Nothing End Sub Sub DelRow() ' by Scossa Dim rRng As Range Dim rCella As Range Dim nCnt1 As Long Dim nCol As Long Dim nCnt2 As Long Dim nLastR As Long Dim nStart As Double Dim xlcalc As XlCalculation With Application xlcalc = .Calculation .DisplayAlerts = False .ScreenUpdating = False .Calculation = xlCalculationManual .StatusBar = "working ... " End With nCol = Selection.Column nLastR = Cells(Rows.Count, nCol).End(xlUp).Row Set rRng = ActiveCell.Resize(nLastR, 1) With rRng nLastR = .Rows.Count nCnt2 = 0 Set rCella = .Cells(nLastR, 1) nStart = Timer For nCnt1 = nLastR To 2 Step -1 If .Cells(nCnt1, 1) = .Cells(nCnt1 - 1, 1) Then nCnt2 = nCnt2 + 1 Set rCella = rCella.Offset(-1, 0) Else With rCella If nCnt2 0 Then .Offset(1, 0).Resize(nCnt2).EntireRow.Delete ' Application.StatusBar = "elaborating cells ... remaining " _ ' & nCnt1 End If End With nCnt2 = 0 Set rCella = .Cells(nCnt1 - 1, 1) End If Next nCnt1 MsgBox "elapsed time: " & Timer - nStart End With rRng.Cells(1, 1).Select Application.ActiveWindow.ScrollRow = 1 Set rRng = Nothing Set rCella = Nothing With Application .DisplayAlerts = True .ScreenUpdating = True .Calculation = xlcalc .StatusBar = False End With End Sub Only for information, not for to polemize. Bye! Scossa |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
delete entire row with condition
Appreciate that.
Here we dont have much information. There can be better/faster solutions but again that depends on the requirements. If we are talking about getting into a unique list out of ColA; try the below.. Sub DeleteRows() Dim lngLastRow As Long lngLastRow = ActiveSheet.Cells.Find(What:="*", _ SearchDirection:=xlPrevious, SearchOrder:=xlRows).Row Range("A1:A" & lngLastRow).AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=Range("A" & lngLastRow + 1), Unique:=True Rows("1:" & lngLastRow).Delete End Sub If this post helps click Yes --------------- Jacob Skaria "Scossa" wrote: On 1 Ott, 13:41, Jacob Skaria wrote: Try setting Calculation to manual and disabling Alerts & Screen updating to see 49.5 coming down.. Times (244.9 49.5 and 25.3) measured with this 3 sub modified and used for test: Sub DeleteRows() 'by Jacob Skaria Dim nStart As Double Dim lngRow As Long Dim nCol As Long Dim xlcalc As XlCalculation With Application xlcalc = .Calculation .DisplayAlerts = False .ScreenUpdating = False .Calculation = xlCalculationManual .StatusBar = "working ... " End With nCol = Selection.Column nStart = Timer For lngRow = Cells(Rows.Count, nCol).End(xlUp).Row To 1 Step -1 If WorksheetFunction.CountIf(Columns(nCol), Cells(lngRow, nCol)) _ 1 Then Rows(lngRow).Delete Next MsgBox "elapsed time: " & Timer - nStart Application.StatusBar = False With Application .DisplayAlerts = True .ScreenUpdating = True .Calculation = xlcalc .StatusBar = False End With End Sub Sub dups() ' by JLGWhiz Dim lr As Long, i As Long, sh As Worksheet Dim nCol As Long Dim nStart As Double Dim xlcalc As XlCalculation With Application xlcalc = .Calculation .DisplayAlerts = False .ScreenUpdating = False .Calculation = xlCalculationManual .StatusBar = "working ... " End With Set sh = ActiveSheet nCol = Selection.Column lr = sh.Cells(Rows.Count, nCol).End(xlUp).Row nStart = Timer For i = lr To 2 Step -1 If sh.Cells(i, nCol) = sh.Cells(i - 1, nCol) Then Rows(i).Delete End If Next MsgBox "elapsed time: " & Timer - nStart With Application .DisplayAlerts = True .ScreenUpdating = True .Calculation = xlcalc .StatusBar = False End With Set sh = Nothing End Sub Sub DelRow() ' by Scossa Dim rRng As Range Dim rCella As Range Dim nCnt1 As Long Dim nCol As Long Dim nCnt2 As Long Dim nLastR As Long Dim nStart As Double Dim xlcalc As XlCalculation With Application xlcalc = .Calculation .DisplayAlerts = False .ScreenUpdating = False .Calculation = xlCalculationManual .StatusBar = "working ... " End With nCol = Selection.Column nLastR = Cells(Rows.Count, nCol).End(xlUp).Row Set rRng = ActiveCell.Resize(nLastR, 1) With rRng nLastR = .Rows.Count nCnt2 = 0 Set rCella = .Cells(nLastR, 1) nStart = Timer For nCnt1 = nLastR To 2 Step -1 If .Cells(nCnt1, 1) = .Cells(nCnt1 - 1, 1) Then nCnt2 = nCnt2 + 1 Set rCella = rCella.Offset(-1, 0) Else With rCella If nCnt2 0 Then .Offset(1, 0).Resize(nCnt2).EntireRow.Delete ' Application.StatusBar = "elaborating cells ... remaining " _ ' & nCnt1 End If End With nCnt2 = 0 Set rCella = .Cells(nCnt1 - 1, 1) End If Next nCnt1 MsgBox "elapsed time: " & Timer - nStart End With rRng.Cells(1, 1).Select Application.ActiveWindow.ScrollRow = 1 Set rRng = Nothing Set rCella = Nothing With Application .DisplayAlerts = True .ScreenUpdating = True .Calculation = xlcalc .StatusBar = False End With End Sub Only for information, not for to polemize. Bye! Scossa |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
To give back ground colour for entire row on certain condition | Excel Discussion (Misc queries) | |||
Applying Max Conditonal Formatting to an entire row when condition | Excel Worksheet Functions | |||
How Do I Condition A Entire Row, Based On The Content Of A Single | New Users to Excel | |||
Conditional Format to highlight entire row if a condition is met | Excel Worksheet Functions | |||
Can I delete an entire row if condition is not met? | Excel Worksheet Functions |