VBA Auto Filter duplicated across multiple worksheets

buyers

Board Regular
Joined
Jan 7, 2016
Messages
54
Can you please help me in using the below code to AutoFilter across multiple sheets. I have included a picture. Cells E4, E5, and E6 I would like to be replicated on other sheets as they are changed on the main sheet via a list. Thank you

Screen Shot 2019-12-30 at 9.33.34 PM.png


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("E4:E6")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    ' Change "E3" to the cell the user completes the year in
    Const tlbName = "Table9" 'update to name of table name on relevant sheet
    Dim DateCol, MinYear, MaxYear
    
    DateCol = "F21:F" & Range("F" & Rows.Count).End(xlUp).Row 'change to match your date column
    MinYear = Year(WorksheetFunction.Min(ActiveSheet.Range(DateCol)))
    MaxYear = Year(WorksheetFunction.Max(ActiveSheet.Range(DateCol)))
    
    With ActiveSheet
      If Target.Value >= MinYear And Target.Value <= MaxYear Then
        .ListObjects(tlbName).Range.Columns(1).AutoFilter Field:=1, Criteria1:="TRUE"
      Else
        .ListObjects(tlbName).Range.Columns(1).AutoFilter Field:=1, Criteria1:="TRUE"
      End If
    End With
    Broker_List
  End If
  '
  Dim xCellColumn As Integer
  Dim xTimeColumn As Integer
  Dim xRow, xCol As Integer
  Dim xDPRg, xRg As Range
  xCellColumn = 20
  xTimeColumn = 19
  xRow = Target.Row
  xCol = Target.Column
  If Target.Text <> "" Then
    If xCol = xCellColumn Then
      Cells(xRow, xTimeColumn) = Now()
    Else
      'On Error Resume Next
      Set xDPRg = Target '.Dependents
      For Each xRg In xDPRg
        If xRg.Column = xCellColumn Then
          Cells(xRg.Row, xTimeColumn) = Now()
        End If
      Next
    End If
  End If
End Sub

Sub GetListObjectNames()
  Dim ws As Worksheet
 Dim lo As ListObject
  Dim rng As Range
  Set ws = ActiveSheet
  For Each lo In ws.ListObjects
    Debug.Print lo.Name
    MsgBox lo.Name
  Next lo
End Sub
Sub Broker_List()
    Dim LastRowID1 As Integer
    Dim LastRowID2 As Integer
    Dim StagingRange
    Dim UniqueRange
    
'clear current broker list
    Sheets("Market Overview").Select
    Sheets("Market Overview").Range("C7").Select
    Sheets("Market Overview").Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Sheets("Market Overview").Range("C7").Select

'get new broker list
    Sheets("Inventory Tracker").Select
    Sheets("Inventory Tracker").Range("Table9[[#Headers],[Broker]]").Select
    Sheets("Inventory Tracker").Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
'manipulate data on reference sheet
    Sheets("Reference").Select
    Sheets("Reference").Range("BrokerStaging").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    LastRowID1 = ThisWorkbook.Worksheets("Reference").Cells(Rows.Count, 20).End(xlUp).Row
    StagingRange = "T2:T" & LastRowID1
    ActiveWorkbook.Sheets("Reference").Range(StagingRange).Select
    Selection.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Reference").Range("BrokerUnique"), Unique:=True
    ActiveWorkbook.Sheets("Reference").Range("BrokerUnique").Select
    LastRowID2 = ThisWorkbook.Worksheets("Reference").Cells(Rows.Count, 21).End(xlUp).Row
    UniqueRange = "U3:U" & LastRowID2
    ActiveWorkbook.Sheets("Reference").Range(UniqueRange).Select
'    Selection.Sort.SortFields.Add Key:=Range( _
'        UniqueRange), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
'        xlSortNormal
    ActiveWorkbook.Worksheets("Reference").Range(UniqueRange).Copy
    
'copy new broker list
    Sheets("Market Overview").Select
    Sheets("Market Overview").Range("C7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'Sheets("Market Overview").Range("Year_Market").Value = Sheets("Reference").Range("Year_Market").Value
    'Sheets("Market Overview").Range("SLMM_Market").Value = Sheets("Reference").Range("SLMM_Market").Value
    'Sheets("Market Overview").Range("Rep_Market").Value = Sheets("Reference").Range("Rep_Market").Value
'clear data on reference
    ActiveWorkbook.Worksheets("Reference").Range(UniqueRange).ClearContents
    ActiveWorkbook.Worksheets("Reference").Range(StagingRange).ClearContents
Sheets("Inventory Tracker").Select
Sheets("Inventory Tracker").Range("Rep_Master").Select
End Sub
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
With all this code I will probable not be able to help.
But maybe I will ask a question.
Are you saying all you want is when you change a value in Range("E4") you want that same value to changed in several other sheets?
And the same with E5 and E6

Because if that is what you want you surely do not need all this code.
So since you have written all this code what does it do that you do not like.
This is a lot of code to read.
 
Upvote 0
I'd like it to do as you describe above as well as auto filter based on the the selection in a sheet that is below. I agree that much of the code is probably unnecessary. The other purpose of the code is to unique filter a column and place the unique cells in another sheet, also via auto filter. Hope this helps.
 
Upvote 0
I'd like it to do as you describe above as well as auto filter based on the the selection in a sheet that is below. I agree that much of the code is probably unnecessary. The other purpose of the code is to unique filter a column and place the unique cells in another sheet, also via auto filter. Hope this helps.
I must admit I'm not good at reading a large amount of code like this and try to figure out what the user is attempting to do. And then modify his existing code to do what he wants.

I like knowing in specific detail what the user is attempting to do and then write the entire code myself.

But there are a lot of others on this forum that are very good at that.
This is beyond my knowledgebase.
I will continue to monitor this thread to see what I can learn.
 
Upvote 0

Forum statistics

Threads
1,214,644
Messages
6,120,709
Members
448,983
Latest member
Joaquim_Baptista

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