V
vbastarter
Hi I would like to find out if countif can be used delete all the rows, I
mean If there are 4 rows in a sheet with same First and Last Name I like to
be able to delete all the 4 rows instead of just 3 as this current script
does ? Any thoughts ?
Dim Col As Integer
Dim r As Long
Dim C As Range
Dim N As Long
Dim V As Variant
Dim S As Variant
Dim Rng As Range
Dim strName As String, _
strFNameCol As String, _
strLNameCol As String
strFNameCol = TxtFNCol.Value
strLNameCol = TxtLNCol.Value
On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Col = ActiveCell.Column
If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If
N = 0
For r = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(r, strFNameCol).Value
S = Rng.Cells(r, strLNameCol).Value
If Application.WorksheetFunction.CountIf(Rng.Columns(strFNameCol), V) >
1 And _
Application.WorksheetFunction.CountIf(Rng.Columns(strLNameCol), S) >
1 Then
Rng.Rows(r).EntireRow.Delete
N = N + 1
End If
Next r
EndMacro:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End_of_Data:
MsgBox "Data Extracted"
THX
mean If there are 4 rows in a sheet with same First and Last Name I like to
be able to delete all the 4 rows instead of just 3 as this current script
does ? Any thoughts ?
Dim Col As Integer
Dim r As Long
Dim C As Range
Dim N As Long
Dim V As Variant
Dim S As Variant
Dim Rng As Range
Dim strName As String, _
strFNameCol As String, _
strLNameCol As String
strFNameCol = TxtFNCol.Value
strLNameCol = TxtLNCol.Value
On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Col = ActiveCell.Column
If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If
N = 0
For r = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(r, strFNameCol).Value
S = Rng.Cells(r, strLNameCol).Value
If Application.WorksheetFunction.CountIf(Rng.Columns(strFNameCol), V) >
1 And _
Application.WorksheetFunction.CountIf(Rng.Columns(strLNameCol), S) >
1 Then
Rng.Rows(r).EntireRow.Delete
N = N + 1
End If
Next r
EndMacro:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End_of_Data:
MsgBox "Data Extracted"
THX