Solved

Macro Firing Cell Change

Posted on 2012-12-24
2
436 Views
Last Modified: 2012-12-24
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
0
Comment
Question by:Bright01
2 Comments
 
LVL 50

Accepted Solution

by:
Rgonzo1971 earned 500 total points
ID: 38718063
Hi

With this code in sheet 1 , it will fire the code in sheet 2
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$5" Then
   Worksheets("Sheet2").Range("B1").Value = Target.Value
End If
End Sub

Open in new window


Regards
0
 

Author Closing Comment

by:Bright01
ID: 38718331
Rg,

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

All the best,

B.
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question