Question : Modify Excel VBA to include a range of cells

I need to modify this code slightly clear a range of cells instead of clearing just one specific cell. Any suggestions?

         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:

           
           
          Sub zapit2(targetRange As Range, what As String)
Dim found As Range, first As Range
Set first = targetRange.Find(what, After:=Range("A" & Rows.Count), LookIn:=xlValues, LookAt:=xlWhole)
If Not first Is Nothing Then
    Set found = targetRange.FindNext(first)
    Do While (Not found Is Nothing)
        If (found.Address = first.Address) Then Exit Do
        found.Clear
        Set found = targetRange.FindNext(found)
    Loop
End If
End Sub

Sub zapit()
Dim targetRange As Range
' change this to where you want to work on
Set targetRange = ActiveSheet.Range("A:A")
zapit2 targetRange, "Grp1"
zapit2 targetRange, "Grp2"
End Sub

           
         

Answer : Modify Excel VBA to include a range of cells

I saw your earlier question but didnt post as cyberkiwi had it covered

This was my effort

The range can be changed here

Set rng1 = Intersect(ActiveSheet.UsedRange, Columns("A"))

for the entire sheet use

Set rng1 = ActiveSheet.UsedRange

for columns A:D

Set rng1 = Intersect(ActiveSheet.UsedRange, Columns("A:D"))

etc

Cheers

Dave

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:

           
           
             'Press Alt + F11 to open the Visual Basic Editor (VBE)
'From the Menu, choose Insert-Module.
'Paste the code into the right-hand code window.
'Press Alt + F11 to close the VBE
'Go to Tools … Macro …. Macros and double-click DelRow_OnColumn

Sub DelRow_OnColumn()
    Dim rng1 As Range, rng2 As Range, cel As Range
    Dim FirstAddress As String
    Dim AppCalc As Long
    Dim MyArr
    Dim varr

    MyArr = Array("Widget1", "Product1")

    Set rng1 = Intersect(ActiveSheet.UsedRange, Columns("A"))
    If rng1 Is Nothing Then Exit Sub

    With Application
        AppCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    For Each varr In MyArr
        Set cel = rng1.Find(varr, , xlValues, xlPart, xlByRows)
        If Not cel Is Nothing Then
            FirstAddress = cel.Address
            Do
                Set cel = rng1.FindNext(cel)
                'test to avoid ending up with mutliple selections in one row to delete
                If cel.Address <> FirstAddress Then
                    If Not rng2 Is Nothing Then
                        Set rng2 = Union(rng2, cel)
                    Else
                        Set rng2 = cel
                    End If
                End If
            Loop While FirstAddress <> cel.Address
        End If
    Next varr

    If Not rng2 Is Nothing Then rng2.Clear

    With Application
        .ScreenUpdating = True
        .Calculation = AppCalc
    End With

           
         