Avatar of Bright01
Bright01
Flag for United States of America asked on

Macro Firing Cell Change

EE Pros,

Happy holidays!  

I have a Macro that fires when a change is made to cell B1 (in WS2).  I have modified the Workbook so that I have a Worksheet that has the change I want to make to B1 on a different sheet (Sheet1, Cell D5).  When I input the text into cell D5, I want it to reflect the change in cell B1 and have the macro fire.  Unfortunately, as you may see with the code below, I have to reinter the same data into B1 (WS2).  In otherwords, I need the simple fix of how to reflect a change in Sheet1, Cell D5 into cell B1; then have the Macro fire.

That's it!

Thank you in advance,

B.



Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Err
   
    Dim rgWidth As Range, rgInitialize As Range, targ As Range
    Dim rng1 As Range, rng2 As Range
    Dim rng1LastRow As Long, rng2LastRow As Long
   
    Application.EnableEvents = False
    Application.ScreenUpdating = False


    'Watch this cell for changes
    Set targ = Range("B1")
    'Reinitialize these cells if the watched cell changes
    Set rgInitialize = Union(Range("A3:A50"), Range("C3:C50"))
    'Change the column width of these cells as data changes
    Set rgWidth = Union(Range("B3:B50"), Range("D3:D50"))
    rgWidth.EntireColumn.AutoFit
    If Intersect(targ, Target) Is Nothing Then Exit Sub
   
   
    rgInitialize.ClearContents
    rng1LastRow = Range("B" & Rows.Count).End(xlUp).Row
    rng2LastRow = Range("D" & Rows.Count).End(xlUp).Row
       
    Set rng1 = Range("B1:B" & rng1LastRow)
    Set rng2 = Range("D1:D" & rng2LastRow)
   
    If Not Intersect(Target, rng1) Is Nothing Then
        With Range("A" & Target.Row).Validation
            .Delete
            If Len(Trim(Target.Value)) <> 0 Then
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="H,M,L"
            End If
        End With
    ElseIf Not Intersect(Target, rng2) Is Nothing Then
        With Range("C" & Target.Row).Validation
            .Delete
            If Len(Trim(Target.Value)) <> 0 Then
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="H,M,L"
            End If
        End With
    End If
Sidz:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Exit Sub
Err:
    MsgBox Err.Description
    GoTo Sidz
End Sub
Microsoft Excel

Avatar of undefined
Last Comment
Bright01

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
Rgonzo1971

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Bright01

ASKER
Rg,

Thank you!  Works perfectly.......... Have a great holiday.

All the best,

B.
Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes