How do I delete entries from all worksheets at the same time?

Question

I have code that should let me paste a value into all worksheets in a workbook (it does work but its a little slow). Then it should also be able to when a value is deleted, it should delete that row from every single other worksheet?

But it doesn't do that unfortunately, it actually does absolutely nothing, and I'm unsure where I'm going wrong. Any ideas would be more than appreciated.

Debugging it looks like the Application.CountBlank(irg) = 1 is never met even though IRG upon cell deletion as the target cell should definitely be blank and a delete should run the worksheet change event?

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Const cCol As String = "A" Const fRow As Long = 2

Dim crg As Range Dim ddFound As Range Dim ws As Worksheet Dim sh As Worksheet Dim outpt As String

Dim i As Integer

Application.EnableEvents = False

Set crg = Columns(cCol).Resize(Rows.Count - fRow + 1).Offset(fRow - 1)
Dim irg As Range: Set irg = Intersect(crg, Target)
Dim sraddress As String


Dim dws As Worksheet
Dim ddcrg As Range



    For Each ws In ActiveWorkbook.Worksheets
            
            Set ddcrg = ws.Columns(cCol)
            sraddress = irg.Value2
            Set ddFound = ddcrg.Find(sraddress, , xlValues, xlWhole)
            
            Application.ScreenUpdating = False
            
            If Application.CountBlank(irg) = 0 Then
            If ddFound Is Nothing Then
            
            irg.Select:   ActiveCell = irg.Value2
            
            irg.Copy
            
            ws.Range(irg.Address) = irg.Value2

            Application.CutCopyMode = False
            
            ElseIf Application.CountBlank(irg) = 1 And ddFound Is Nothing Then
            
            Sheets(Array("Statistics", "January")).Select
            ddFound.EntireRow.Delete Shift:=xlShiftUp
        End If
    End If
    
    Next ws

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

re: "it's a little slow" - rather than copy/pasting values, it may be quicker to set the cell value directly. For example, instead of using Range("A1").Copy:Range("B1").PasteSpecial Paste:=xlPasteValues, it's about 30x faster to just assign the value directly like Range("B1")=Range("A1"). Also for this kind of stuff Application.ScreenUpdating=False makes a big difference to performance, added just before starting a loop (and don't forget to re-enable it afterwards.) Here's the documentation on that. — ashleedawg
also re:performance - There's some good info about performance here and here and also "How to avoid using Select in Excel VBA". — ashleedawg
Is there any difference between Target and irg, since is the result of an intersection between Target and a column range? Can Target contain multiple columns? If so and only one row, the cell on the specific column is set. Counting in a single cell is not the best option... Can it contain more rows? In such a case sraddress = irg.Value2 will return an error. It makes sense only for a single cell. Can you clarify the above mentioned issues, please? — FaneDuru
Why do you use Set dws = Worksheets(i) and the iteration, since you already have ws? If you need excepting some sheets, you can do it conditioning the execution for ws.Name <> "Sheet to be excepted". Then, no selection is necessary to do all operation you try executing. This only consumes Excel resources, makes the code slower and does not bring any benefit. And allocating the value directly, as mentioned in the previous comment, the code will become faster. The rows deletion is tricky in your case. If you firstly delete one row, according to a specific case, the next are messed up. — FaneDuru
For deletion, since it is done in the same sheet, you should create a Union range, let us say, rngDel which to delete its EntireRow at once, at the end of the code. This will make your code also much faster, instead of each row deletion. If you clarify the issues I put in discussion, I can post a working code. Of course, based on what I will be able to understand about your real need... Please, better explain the context. — FaneDuru

FaneDuru FaneDuru · Accepted Answer · 2021-12-23T12:27:30

Please, try the next code. It assumes that Target may have more columns, but only one row:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Const cCol As String = "A"
  Const fRow As Long = 2
  Dim crg As Range, ddFound As Range, ws As Worksheet, i As Long

 Application.EnableEvents = False

  Set crg = Columns(cCol).Resize(rows.Count - fRow + 1).Offset(fRow - 1)
  Dim irg As Range: Set irg = Intersect(crg, Target)
  If Target.rows.Count > 1 Then Exit Sub 'no more then one row admitted
  If irg Is Nothing Then Exit Sub
  Dim sraddress As String, ddcrg As Range
  Dim rngDelS As Range, rngDelJ As Range 'ranges to keep rows to be deleted

  For Each ws In ActiveWorkbook.Worksheets
   If ws.Index <= 13 Then
        Set ddcrg = ws.Columns(cCol)
        sraddress = irg.Value2
        Set ddFound = ddcrg.Find(sraddress, , xlValues, xlWhole)
    
        If irg.Value <> "" Then
            If ddFound Is Nothing Then
                ws.Range(irg.Address).Value2 = irg.Value2
            ElseIf irg.Value = "" And Not ddFound Is Nothing Then
                If rngDelS Is Nothing Then
                    Set rngDelS = Sheets("Statistics").Range(ddFound.Address)
                    Set rngDelJ = Sheets("January").Range(ddFound.Address)
                Else
                    Set rngDelS = Union(rngDelS, Sheets("Statistics").Range(ddFound.Address))
                    Set rngDelJ = Union(rngDelJ, Sheets("January").Range(ddFound.Address))
                End If
            End If
          End If
    End If
  Next ws
  If Not rngDelS Is Nothing Then 'delete the necessary rows, at once, per each sheet:
     rngDelS.EntireRow.Delete
     rngDelJ.EntireRow.Delete
  End If
  Application.EnableEvents = True
End Sub

How do I delete entries from all worksheets at the same time?

1 Answers