Auto run macro on all worksheets except sheet 1 when cell value in sheet 1 changes

DevC

New Member
Joined
Jun 17, 2020
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Hi to All,

I am new to VBA code writing and having problem in executing a code. I have a workbook with 20 sheets. The first sheet named "Summary" has a cell reference B5 wherein user will have to input a 4 digit code. Once entered a macro will run on all other worksheets deleting rows except the header without the 4 digit code. In all worksheets the column to search the 4 digit code is column A. I am using the following code, which I have got after doing google search;

Sub DeleteRows()
'Updateby20140314
Dim rng As Range
Dim InputRng As Range
Dim DeleteRng As Range
Dim DeleteStr As String

xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = ActiveSheet.Range("A3:A200000")
DeleteStr = Worksheets("Summary").Range("B5")

For Each rng In InputRng
If rng.Value <> DeleteStr Then
If DeleteRng Is Nothing Then
Set DeleteRng = rng
Else
Set DeleteRng = Application.Union(DeleteRng, rng)
End If
End If
Next
DeleteRng.EntireRow.Delete

End Sub

But I am unable to automate the workbook so that the macro will trigger whenever any data is feed in "Summary" Sheet Cell "B5".

If anyone can help me it will be really great.
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Add this to the Worksheet module

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

    Set KeyCells = Range("B5")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

Call DeleteRows

End If
End Sub
 
Upvote 0
Thanks mrshl9898 for your reply. It seems there is some problem.

1) The macro is not starting whenever a 4 digit code is entered in cell B5. I have to press F5 on each worksheet to run the macro
2) Data from first sheet "Summary" is also getting deleted.

Please help.
 
Upvote 0
If the macro is in the sheet module it should be running,

1592455785837.png


Can test it with the below.


VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

    Set KeyCells = Range("B5")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

msgbox "working"

End If
End Sub

As for the sheets, I can't see anything in your code that loops through the sheets.

So maybe call this loop from the macro instead?

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

    Set KeyCells = Range("B5")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

Call loopsheets

End If
End Sub

VBA Code:
Sub loopsheets()



For Each Sheet In ThisWorkbook.Sheets
    If Sheet.Name <> "Summary" Then
        DeleteRows
    End If
Next Sheet
 
End Sub
 
Upvote 0
Hi,

Some how it is not working.

Can I upload a test file.

Really urgently need to solve this.
 
Upvote 0
Hi,

I am new to VBA code writing so i think I am making some mistake.

I am copying and pasting the below mentioned code in the first sheet module i.e. "Summary" Sheet;

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range

Set KeyCells = Range("B5")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then

Call loopsheets

End If
End Sub

Sub loopsheets()



For Each Sheet In ThisWorkbook.Sheets
If Sheet.Name <> "Summary" Then
DeleteRows
End If
Next Sheet

End Sub

Sub DeleteRows()
'Updateby20140314
Dim rng As Range
Dim InputRng As Range
Dim DeleteRng As Range
Dim DeleteStr As String

xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = ActiveSheet.Range("A3:A200000")
DeleteStr = Worksheets("Summary").Range("B5")

For Each rng In InputRng
If rng.Value <> DeleteStr Then
If DeleteRng Is Nothing Then
Set DeleteRng = rng
Else
Set DeleteRng = Application.Union(DeleteRng, rng)
End If
End If
Next
DeleteRng.EntireRow.Delete

End Sub

Though the macro is auto starting but it is giving error highlighting the row "DeleteRng.EntireRow.Delete"

Unable to understand what the problem is.

Please help.
 
Upvote 0
Struggling with this double negative sorry.

"deleting rows except the header without the 4 digit code"

So delete rows with the code?

Not sure about the first code so I can't help much there. Try this instead:

VBA Code:
Public myval


Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range

Set KeyCells = Range("B5")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
myval = Range("B5")
Call loopsheets

End If
Sheets("Summary").Select

End Sub

Sub loopsheets()

Dim r As Integer

For Each Sheet In ThisWorkbook.Sheets
If Sheet.Name <> "Summary" Then
Sheet.Select
DeleteRowWithContents
End If
Next Sheet

End Sub


Sub DeleteRowWithContents()

Dim ws As Worksheet
Dim last As Long

Set ws = ActiveSheet

    last = ws.Cells(Rows.Count, "A").End(xlUp).Row
    For i = last To 1 Step -1
        If (ws.Cells(i, "A").Value) = myval Then
            ws.Cells(i, "A").EntireRow.Delete
        End If
    Next i
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,486
Messages
6,113,932
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top