run VBA from button on another sheet, check if already run

[DEWITTDS]

Joe4 posted the following code to delete rows based on cell value. I have two problems.
#1 I need to run this from a button on another Sheet. How do I make it run on the desired sheet?

#2 If the user runs it twice it deletes all data on sheet except for first row. How do I have it check if there are no "0" then exit ?

Sub MyDeleteMacro()
'
    Dim lr As Long, lr2 As Long

    Application.ScreenUpdating = False

'   Find last row with data in column P
    lr = Cells(Rows.Count, "P").End(xlUp).Row
    
'   Hide all rows not equal to zero
    Columns("P:P").AutoFilter
    ActiveSheet.Range("$P$1:$P$" & lr).AutoFilter Field:=1, Criteria1:="0"
    
'   Find last row in column P with data after filter
    lr2 = Cells(Rows.Count, "P").End(xlUp).Row

'   Exit sub if no data to delete data (only header visible)
    If lr2 = 2 Then Exit Sub

'   Delete unhidden data
    Application.DisplayAlerts = False
    ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
    Application.DisplayAlerts = True

'   Remove filter
    Range("P1").AutoFilter
    
    Application.ScreenUpdating = True
    
End Sub

​

 

[Micron]

Wherever you reference a range, cells or sheet, include a reference to the sheet name you need (you didn't provide that info). So try (for example)
Sheets("Sheet1").Cells(Rows.Count, "P").End(xlUp).Row

Or use 1 or more sheet variables, such as
Dim sht As Worksheet

Set sht = Sheets("Sheet1")
sht.Cells(Rows.Count, "P").End(xlUp).Row

As for #2, no zeros where? Anywhere on the sheet? I'd avoid using ActiveSheet if there's a chance that the wrong sheet is the active sheet. I realize the active sheet will be the one with the button that runs the code - unless you accidentally run the sub by some other means.

 

[dermie_72]

The easiest way would be to activate the sheet you want to run the macro on at the top of the macro.

Sheets("Sheet name here").Activate

To see if it needs to be run, you can set a condition of

If application.worksheetfunction.countif(Range("P:P",0) = 0 then
exit sub
else
end if

 

[MikeVol]

Another Variant. Suppose you run this macro from sheet1 and the macro code should work on a datasheet sheet. Then the macro code will have small modifications and additions, taking into account your second request.

Option Explicit

Sub MyDeleteMacro()
    Dim lr As Long, lr2 As Long
    Dim ws As Worksheet
    Dim zeroCount As Long

    ' Set the worksheet you want to work with
    Set ws = ThisWorkbook.Sheets("DataSheet")   ' Change "DataSheet" to your actual sheet name

    Application.ScreenUpdating = False

    ' Find last row with data in column P
    lr = ws.Cells(ws.Rows.Count, "P").End(xlUp).Row

    ' Count the number of zeros in column P
    zeroCount = Application.WorksheetFunction.CountIf(ws.Range("P2:P" & lr), 0)

    ' Exit sub if there are no zeros
    If zeroCount = 0 Then
        MsgBox "No zeros found in column P. No rows will be deleted.", vbInformation
        Set ws = Nothing
        Application.ScreenUpdating = True
        Exit Sub
    End If

    ' Hide all rows not equal to zero
    ws.Columns("P:P").AutoFilter
    ws.Range("$P$1:$P$" & lr).AutoFilter Field:=1, Criteria1:="0"

    ' Find last row in column P with data after filter
    lr2 = ws.Cells(ws.Rows.Count, "P").End(xlUp).Row

    ' Exit sub if no data to delete (only header visible)
    If lr2 = 2 Then Exit Sub

    ' Delete unhidden data
    Application.DisplayAlerts = False
    ws.UsedRange.Offset(1, 0).Resize(ws.UsedRange.Rows.Count - 1).Rows.Delete
    Application.DisplayAlerts = True

    ' Remove filter
    ws.Range("P1").AutoFilter

    Set ws = Nothing
    Application.ScreenUpdating = True
End Sub

 

[PeteWright]

Joe4 posted the following code to delete rows based on cell value. I have two problems.
#1 I need to run this from a button on another Sheet. How do I make it run on the desired sheet?

#2 If the user runs it twice it deletes all data on sheet except for first row. How do I have it check if there are no "0" then exit ?

Hi @DEWITTDS
I checked your requirements and re-wrote the Macro from scratch so it should solve both of your problems.
My code uses a different approach without filtering the rows first.

Place a button anywhere in your Workbook and edit the VBA code variables so they match your requirements.
The variables you should check are as follows:
WorksheetName (The displayed name of the worksheet, where the macro should be processed)
Criteria1, Criteria2, Criteria3 (Criteria or cell value that has to be found to delete the entire row)

Option Explicit
Option Base 1
Sub zero()
   Dim WorksheetName As String
   Dim Criteria1 As String, Criteria2 As String, Criteria3 As String
   ' Change the name of your worksheet as needed
   WorksheetName = "Register" ' <--- displayed name of the worksheet to be processed
   ' Add up to 3 Criteria for Column P when the entire row should be deleted
   ' When Criteria1 OR Criteria2 OR Criteria3 is met, then the entire row will be deleted!
   Criteria1 = 0
   Criteria2 = "0"
   Criteria3 = ""
   
   Application.ScreenUpdating = False
   Dim l As Long, i As Long, w As Worksheet
   Set w = ThisWorkbook.Worksheets(WorksheetName)
   l = w.Cells(w.Rows.Count, "P").End(xlUp).Row
   For i = l To 1 Step -1
      If (w.Cells(i, "P") = Criteria1 Or w.Cells(i, "P") = Criteria2 Or w.Cells(i, "P") = Criteria3) Then
         w.Rows(i).EntireRow.Delete
      End If
   Next i
   Application.ScreenUpdating = True
End Sub

 

[DEWITTDS]

MikeVol,

Your answer work fantastic. Others did also but Mike's ran the fastest. I can see this sheet in time having 10,000 plus lines.

 

[MikeVol]

Hello @DEWITTDS, So this code is not mine, I just modified it. Say thanks to the author who wrote it for you earlier.
I was glad to help you. Good luck.