VBA User defined - delee Row help

[Mallesh23]

Hi Team,

MY userdefined function works for deleting single and Multiple items as per Criteria Provided.

Now I want to reverse it , it should delete all player name excluding Below player.
str = "Sachin Tendulkar,Virender Sehwag"


Need your help to make this function Dynamic,

Option Explicit
Sub DeleteRow_Excudelist_Not_Working()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Dim a As Variant
    Dim str As String
    Dim Ary() As String
    
    a = ws.Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
    
 
    str = "Sachin Tendulkar,Virender Sehwag"   'Delete both the Record, how to make opposite of it.  exclude it
     'Ary = Split(str, ",")
 
    'Call Function
    DeleteRow ws, a, str, 1 'Delete Multiple Criteria
   

  MsgBox "Macro Successful"

End Sub


Function DeleteRow(ByVal ws As Worksheet, ByVal a As Variant, ByVal str As String, Optional ByVal HeaderRow As Long = 1)
  Dim nc As Long, i As Long, k As Long
  Dim b As Variant, j As Long
  Dim DataRow As Long
  DataRow = HeaderRow + 1
  Dim Ary As Variant

  Ary = Split(str, ",")

     
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    For j = 0 To UBound(Ary)
            If a(i, 1) = Ary(j) Then
                b(i, 1) = 1
                k = k + 1
            End If
    Next j
  Next i

  If k > 0 Then
    Application.ScreenUpdating = False
 
    With ws.Range("A" & DataRow).Resize(UBound(a), nc) 'How to make this line dynamic if startRow changes.
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If

End Function

Below is a Table

Delete Entire Row Function.xlsm
	A	B	C
1	Big Hitters	SIXES	Fours
2	Sourav Ganguly	359	1240
3	Adam Gilchrist	363	3597
4	Sachin Tendulkar	372	3984
5	Virender Sehwag	398	1729
6	Sourav Ganguly	443	2829
7	Adam Gilchrist	475	1888
8	Sachin Tendulkar	431	2813
9	Virender Sehwag	421	3646
10	Shane Watson	465	2526
11	Sachin Tendulkar	458	3677
12	Sachin Tendulkar	382	3754
13	Virender Sehwag	212	1106
14	Sourav Ganguly	456	1484
15	Sachin Tendulkar	240	2340
16	Sachin Tendulkar	466	2480
17	Virender Sehwag	417	1079
18	Shane Watson	280	3595
19	Virender Sehwag	280	3595
20	Sourav Ganguly	359	1240
21	Adam Gilchrist	363	3597
22	Sachin Tendulkar	372	3984
23	Virender Sehwag	398	1729
24	Sourav Ganguly	443	2829
25	Adam Gilchrist	475	1888
26	Sachin Tendulkar	431	2813
27	Virender Sehwag	421	3646
28	Shane Watson	465	2526
29	Adam Gilchrist	458	3677
30	Sachin Tendulkar	382	3754
31	Virender Sehwag	212	1106
32	Sourav Ganguly	456	1484
33	Adam Gilchrist	240	2340
34	Sachin Tendulkar	466	2480
35	Virender Sehwag	417	1079
36	Virender Sehwag	417	1079
37	Sourav Ganguly	359	1240
38	Adam Gilchrist	363	3597
39	Sachin Tendulkar	372	3984
40	Virender Sehwag	398	1729
41	Sourav Ganguly	443	2829
42	Adam Gilchrist	475	1888
43	Sachin Tendulkar	431	2813
44	Virender Sehwag	421	3646
45	Shane Watson	465	2526
46	Adam Gilchrist	458	3677
47	Sachin Tendulkar	382	3754
48	Virender Sehwag	212	1106
49	Sourav Ganguly	456	1484
50	Adam Gilchrist	240	2340
51	Sachin Tendulkar	466	2480
52	Virender Sehwag	417	1079
53	Shane Watson	280	3595
54	Shane Watson	280	3595
55	Sourav Ganguly	359	1240
56	Adam Gilchrist	363	3597
57	Sachin Tendulkar	372	3984
58	Virender Sehwag	398	1729
59	Sourav Ganguly	443	2829
60	Adam Gilchrist	475	1888
61	Sachin Tendulkar	431	2813
62	Virender Sehwag	421	3646
63	Shane Watson	465	2526
64	Adam Gilchrist	458	3677
65	Sachin Tendulkar	382	3754
66	Virender Sehwag	212	1106
67	Sourav Ganguly	456	1484
68	Adam Gilchrist	240	2340
69	Sachin Tendulkar	466	2480
70	Virender Sehwag	417	1079
71	Shane Watson	280	3595
Sheet2

Below is dummy expected output

Delete Entire Row Function.xlsm
	E	F	G
1	Big Hitters	SIXES	Fours
4	Sachin Tendulkar	431	2813
5	Virender Sehwag	421	3646
8	Virender Sehwag	212	1106
9	Sachin Tendulkar	458	3677
Sheet2

Thanks
mg

 

[Fluff]

How about

Function DeleteRow(ByVal ws As Worksheet, ByVal a As Variant, ByVal str As String, Optional ByVal HeaderRow As Long = 1)
  Dim nc As Long, i As Long, k As Long
  Dim b As Variant, j As Long
  Dim DataRow As Long
  DataRow = HeaderRow + 1
  Dim Ary As Variant

  Ary = Split(str, ",")

      
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
      If IsError(Application.Match(a(i, 1), Ary, 0)) Then
          b(i, 1) = 1
          k = k + 1
      End If
  Next i

  If k > 0 Then
    Application.ScreenUpdating = False
  
    With ws.Range("A" & DataRow).Resize(UBound(a), nc) 'How to make this line dynamic if startRow changes.
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If

End Function

 

[Mallesh23]

Hi Fluff,

Great ! it worked as expected, how to make further dynamic,

Function to delete include list... If provided include list.
Function to delete All Exclude list... If provided Exclude list. both in a single function.

Thanks in advance!



Thanks
mg

 

[Fluff]

How about

Function DeleteRow(ByVal ws As Worksheet, ByVal a As Variant, ByVal str As String, Optional ByVal HeaderRow As Long = 1, Optional Inc_Exc As Boolean = True)
  Dim nc As Long, i As Long, k As Long
  Dim b As Variant, j As Long
  Dim DataRow As Long
  DataRow = HeaderRow + 1
  Dim Ary As Variant

  Ary = Split(str, ",")

      
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  ReDim b(1 To UBound(a), 1 To 1)
  If Inc_Exc Then
      For i = 1 To UBound(a)
          If Not (IsError(Application.Match(a(i, 1), Ary, 0))) Then
              b(i, 1) = 1
              k = k + 1
          End If
      Next i
  Else
      For i = 1 To UBound(a)
          If IsError(Application.Match(a(i, 1), Ary, 0)) Then
              b(i, 1) = 1
              k = k + 1
          End If
      Next i
  End If
  If k > 0 Then
    Application.ScreenUpdating = False
  
    With ws.Range("A" & DataRow).Resize(UBound(a), nc) 'How to make this line dynamic if startRow changes.
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If

End Function

 

[Mallesh23]

Hi Fluff,

Thats Perfect !! Thanks again for your help , it worked ! ?


Thanks
mg

 

[Fluff]

Glad to help & thanks for the feedback.