Slight Code Modification to change Sheet

EE Pros,

I have a Macro and need but one thing.  I need to change the String reference on the SelectedCurrency (i.e. ="D4"), to refer it to a different Worksheet (i.e. Sheet2 and Cell F2). How do I properly refer the Select cell to the other sheet so as to fire the macro from the other sheet?

Here is the Code:


Option Explicit

Const SelectedCurrency As String = "D4"
Const CurrencyList As String = "B4:B12"
Const ChangeCellStart As String = "E4"

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rFind As Range, rStep As Range
    Dim sSheet As String, sRange As String
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Address = Me.Range(SelectedCurrency).Address Then
        Set rFind = Me.Range(CurrencyList).Find(What:=Target.Value, LookAt:=xlWhole)
        If Not rFind Is Nothing Then
            For Each rStep In Me.Range(Me.Range(ChangeCellStart), Me.Cells(Me.Rows.Count, Me.Range(ChangeCellStart).Column).End(xlUp))
                On Error Resume Next
                If InStr(1, rStep.Value, "!") = 0 Then
                    Me.Range(rStep.Value).NumberFormat = rFind.Offset(0, 1).NumberFormat
                Else
                    sSheet = Trim(Left(rStep.Value, InStr(1, rStep.Value, "!") - 1))
                    sRange = Trim(Right(rStep.Value, Len(rStep.Value) - InStr(1, rStep.Value, "!")))
                    If Left(sSheet, 1) = "'" Then sSheet = Right(sSheet, Len(sSheet) - 1)
                    If Right(sSheet, 1) = "'" Then sSheet = Left(sSheet, Len(sSheet) - 1)
                    ThisWorkbook.Worksheets(sSheet).Range(sRange).NumberFormat = rFind.Offset(0, 1).NumberFormat
                End If
                On Error GoTo 0
            Next rStep
        End If
    End If
End Sub
Bright01Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

[ fanpages ]IT Services ConsultantCommented:
Hi again,

The simplest way would be to copy the code (you have posted above) to the worksheet code module for [Sheet2] & simply change the assignment of:

Const SelectedCurrency As String = "D4"
to
Const SelectedCurrency As String = "F2"

The Worksheet_Change() event will then trigger when a cell is changed on [Sheet2].

BFN,

fp.
0
Bright01Author Commented:
BFN,

Greetings!  Glad you picked this up since you are very familiar with it!  Here's the problem with what you proposed, all of the other information is on the other Worksheet.  It's only the "selection" that I'm trying to trigger from the other Worksheet.  I thought I could simply reference it in D4 (i.e. = Sheet2! "F2") but that doesn't trigger the event; so I tried to modify the macro instead.  That didn't work either.

So if I simply move the code over to Sheet 2, I'm expecting other problems because the reference table for both the currencies and the cell references (to change) remain on the original Worksheet.  

B.
0
byundtMechanical EngineerCommented:
If the trigger cell is on Sheet2, then you must use a Worksheet_Change sub on Sheet2 to trap any changes. This sub could trigger the Worksheet_Change event sub for Sheet1 by changing a value on Sheet1:
Option Explicit

Const SelectedCurrency As String = "F2"     'On Sheet2
Const CurrencyList As String = "B4:B12"     'On Sheet1
Const ChangeCellStart As String = "E4"      'On Sheet1

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range(SelectedCurrency)) Is Nothing Then
    Worksheets("Sheet1").Range("D4").Value = Me.Range(SelectedCurrency).Value
End If
End Sub

Open in new window


if you don't want to change the value of cell D4 on Sheet1, then you could use a modified version of your previous code:
Option Explicit

Const SelectedCurrency As String = "F2"     'On Sheet2
Const CurrencyList As String = "B4:B12"     'On Sheet1
Const ChangeCellStart As String = "E4"      'On Sheet1

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rFind As Range, rStep As Range
    Dim sSheet As String, sRange As String
    If Target.Cells.Count > 1 Then Exit Sub
    
    With Worksheets("Sheet1")
        If Target.Address = Me.Range(SelectedCurrency).Address Then
            Set rFind = .Range(CurrencyList).Find(What:=Target.Value, LookAt:=xlWhole)
            If Not rFind Is Nothing Then
                For Each rStep In .Range(.Range(ChangeCellStart), .Cells(.Rows.Count, .Range(ChangeCellStart).Column).End(xlUp))
                    On Error Resume Next
                    If InStr(1, rStep.Value, "!") = 0 Then
                        .Range(rStep.Value).NumberFormat = rFind.Offset(0, 1).NumberFormat
                    Else
                        sSheet = Trim(Left(rStep.Value, InStr(1, rStep.Value, "!") - 1))
                        sRange = Trim(Right(rStep.Value, Len(rStep.Value) - InStr(1, rStep.Value, "!")))
                        If Left(sSheet, 1) = "'" Then sSheet = Right(sSheet, Len(sSheet) - 1)
                        If Right(sSheet, 1) = "'" Then sSheet = Left(sSheet, Len(sSheet) - 1)
                        ThisWorkbook.Worksheets(sSheet).Range(sRange).NumberFormat = rFind.Offset(0, 1).NumberFormat
                    End If
                    On Error GoTo 0
                Next rStep
            End If
        End If
    End With
End Sub

Open in new window


I should warn you that the above code compiles, but has not been tested. If you encounter problems, please post a sample workbook so I can replicate your problem and fix it.

Brad
0
Newly released Acronis True Image 2019

In announcing the release of the 15th Anniversary Edition of Acronis True Image 2019, the company revealed that its artificial intelligence-based anti-ransomware technology – stopped more than 200,000 ransomware attacks on 150,000 customers last year.

Bright01Author Commented:
fanpages?
0
byundtMechanical EngineerCommented:
Nope--byundt.

fanpages is likely enjoying a good night's sleep, as he lives in UK.
0
Bright01Author Commented:
Byundt,

The answer may be "brilliant" but youv'e taken a very simple fix and made it so complex, I haven't a clue how to fix the problem. I simply need a way to change the macro to reference a separate spreadsheet for input to a great macro.

B.
0
byundtMechanical EngineerCommented:
Gaak! I can understand why you were confused--my previous Comment was somewhat of a jumble.

I subsequently rearranged the code in that Comment into two snippets. I believe that either of those snippets will do what you requested. Install the chosen snippet in Sheet2 code pane.

If you are still confused, please post a file so I can install the code for you and test it.

Brad
0
Bright01Author Commented:
For some reason, I think it's a matter of addressing one line of code...... line item 3.  You've provided a very complex fix to a very simple problem.  Referencing a line of code from another sheet.... it cannot possibly be this hard.

B.
0
byundtMechanical EngineerCommented:
I believe the following summarizes your situation:
1. You want a macro to run when somebody changes the value of Sheet2 cell F2.
2.  The macro that will run already exists in Sheet1.
3.  The problem is that the Sheet1 macro is triggered by a change to Sheet1 cell D4.
4.  The following formula in Sheet1 cell D4 does not trigger the macro when its value changes:
=Sheet2!F2

If you want a macro to run when somebody changes Sheet2 cell F2, you need a Worksheet_Change sub in Sheet2 code pane. One approach is for that sub to copy the value from Sheet2 cell F2 and paste it in Sheet1 cell D4. In so doing, it triggers the Sheet1 macro that already does what you need.
Option Explicit

Const SelectedCurrency As String = "F2"     'On Sheet2

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range(SelectedCurrency)) Is Nothing Then
    Worksheets("Sheet1").Range("D4").Value = Me.Range(SelectedCurrency).Value
End If
End Sub

Open in new window

0
[ fanpages ]IT Services ConsultantCommented:
If you want a macro to run when somebody changes Sheet2 cell F2, you need a Worksheet_Change sub in Sheet2 code pane. One approach is for that sub to copy the value from Sheet2 cell F2 and paste it in Sheet1 cell D4. In so doing, it triggers the Sheet1 macro that already does what you need.

I like that approach, but hope that doesn't come back to "bite" in the future will a cyclical Worksheet_Change() cascading-callback catastrophe! :s  In fact, I like that so much, I may trademark that phrase! ;)


Seriously, if you did try what I suggested at the top of this thread, B, I now see that you would have hit a few issues (that I have addressed below).

Please find attached an update to the workbook you provided in your earlier question thread:

[ http://www.experts-exchange.com/Microsoft/Applications/Q_28249192.html#a39522647 ]

This includes the copied code (taken from "Sheet18" [Currency] worksheet) with modified line I mentioned.  I pasted this into "Sheet2" [Customer - Inputs] worksheet.

I then copied cell [D4] from [Currency] & pasted this into [F2] on [Customer - Inputs].  I changed the Data Validation range (from =$B$4:$B$12) to =Currency!$B$4:$B$12 (so that the correct range, on the correct worksheet, was still referenced).

I defined a Worksheet object, objMe, that is simply a reference to the [Currency] worksheet.  I changed references to Me. to objMe. within the code so that the look-up routine previously used still functioned, but the code still looked similar to before.  I did, however, add some spaces around some code statement lines just for ease of reading.

I also commented-out a few lines of code throughout the entire project as they seemed to have been copied'n'pasted from elsewhere & were causing the project not to compile successfully.  I added the comment ' *** fp. [26/09/2013]: Commented-out to each of these lines.

Finally, I added a new code module, "basQ_28249837", that simply defines the two subroutines Protect_OFF() & Protect_ON().

I presume you removed these from the original workbook as they included details of a password.

The two routines I added do nothing other than let the code compile.


So, in summary, this is (now) the code module for "Sheet2" [Customer - Inputs] within the attached workbook:

Option Explicit

Const SelectedCurrency As String = "F2"                                 ' *** fp. [26/09/2013]: Changed from "D4" to "F2"
Const CurrencyList As String = "B4:B12"
Const ChangeCellStart As String = "E4"
Private Sub Worksheet_Change(ByVal Target As Range)
    
  Dim objMe                                             As Worksheet    ' *** fp. [26/09/2013]: Added
  Dim rFind                                             As Range
  Dim rStep                                             As Range
  Dim sSheet                                            As String
  Dim sRange                                            As String
  
  Set objMe = Worksheets("Currency")                                    ' *** fp. [26/09/2013]: Added
  
  If Target.Cells.Count > 1& Then
     Exit Sub
  End If ' If Target.Cells.Count > 1& Then
  
  If Target.Address = objMe.Range(SelectedCurrency).Address Then
     Set rFind = objMe.Range(CurrencyList).Find(What:=Target.Value, LookAt:=xlWhole)
     
     If Not rFind Is Nothing Then
        For Each rStep In objMe.Range(objMe.Range(ChangeCellStart), objMe.Cells(objMe.Rows.Count, objMe.Range(ChangeCellStart).Column).End(xlUp))
        
            On Error Resume Next
            
            If InStr(1, rStep.Value, "!") = 0 Then
               objMe.Range(rStep.Value).NumberFormat = rFind.Offset(0, 1).NumberFormat
            Else
               sSheet = Trim(Left(rStep.Value, InStr(1, rStep.Value, "!") - 1))
               sRange = Trim(Right(rStep.Value, Len(rStep.Value) - InStr(1, rStep.Value, "!")))
               
               If Left(sSheet, 1) = "'" Then
                  sSheet = Right(sSheet, Len(sSheet) - 1)
               End If ' If Left(sSheet, 1) = "'" Then
               
               If Right(sSheet, 1) = "'" Then
                  sSheet = Left(sSheet, Len(sSheet) - 1)
               End If ' If Right(sSheet, 1) = "'" Then
               
               ThisWorkbook.Worksheets(sSheet).Range(sRange).NumberFormat = rFind.Offset(0, 1).NumberFormat
            End If ' If InStr(1, rStep.Value, "!") = 0 Then
            
            On Error GoTo 0
            
            Next rStep
        End If ' If Not rFind Is Nothing Then
    End If ' If Target.Address = objMe.Range(SelectedCurrency).Address Then

End Sub
'Private Sub CmdSummary_Click()                                         ' *** fp. [26/09/2013]: Commented-out
'ProtectOFF
'    Select Case CmdSummary.Caption
'        Case Split(SumBtnCaps, ",")(NsbSummary)
'            ViewSummary NwsViewSummary
'        Case Split(SumBtnCaps, ",")(NsbExpanded)
'            ViewSummary NwsViewAll
'    End Select
'ProtectON
'        Range("d1").Activate
'End Sub
Private Sub CmdBack_Click()
    ExpandRange ActiveCell, -1
End Sub
Private Sub CmdNext_Click()
    ExpandRange ActiveCell, 1
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
                                        Cancel As Boolean)
    
    If Target.Column = 2 Then
        Cancel = ExpandRange(Target.Cells(1))
    End If

End Sub
Sub Confirm_ModelReset()
Dim I As Integer
If MsgBox("Are you sure want to reset the Tealeaf Total Economic Impact Model? All Input will be lost!", vbYesNo) = vbYes Then
'  Call ClearTEIQuestionaireFields                                      ' *** fp. [26/09/2013]: Commented-out
End If
End Sub
Sub Confirm_Demo()
Dim I As Integer
If MsgBox("This will simulate a average ROI based on specific Conditions.  Do you want to proceed?  All previous data will be lost!", vbYesNo) = vbYes Then
'  Call DemoTEIFields                                                   ' *** fp. [26/09/2013]: Commented-out
End If
End Sub

Open in new window


Please can you review the changes I have made to see if they address your requirements?

Thank you.


This said, Brad's input should not be ignored.  He had tried to make the process easier to read/maintain.  The code in this VB(A) project seems to have gone through many iterations of development.  I think there has been copy'n'pasting of existing code to different code modules (panes) in a couple of instances, & the whole project could do with some "tidying" just for the sake of ease of reading &/or ease of maintenance in the future.

BFN,

fp.
Q-28249837.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Bright01Author Commented:
Interesting!  OK..... I copied the code into my production version and it worked very well. I had to take two of the comment fields out and reset the macros in order to have the production version work;

Call ClearTEIQuestionaireFields

and

Call DemoTEIFields  

I tested it and it seems that it works just fine.  I'm not sure what this code actually did;

'Private Sub CmdSummary_Click()                                         ' *** fp. [26/09/2013]: Commented-out
'ProtectOFF
'    Select Case CmdSummary.Caption
'        Case Split(SumBtnCaps, ",")(NsbSummary)
'            ViewSummary NwsViewSummary
'        Case Split(SumBtnCaps, ",")(NsbExpanded)
'            ViewSummary NwsViewAll
'    End Select
'ProtectON
'        Range("d1").Activate
'End Sub

I'll have to tell you something funny.  After you provided the code to change the decimal to -0-, I realized that although it improved 98% of the numbers it changed..... I had several input fields that were in "cents" which then required 2 digits!  So I had to remove them from the Currency macro and simply put in a line that said, "Input in 2 Decimals in Current Currency".   OK..... I thought it was funny.

Thanks for the code.... works well.  I'll close out this question shortly.  And I also liked Brad's approach, it's just it was slightly more complicated for me to understand and test.

Thanks to both of you for the help.

B.
0
[ fanpages ]IT Services ConsultantCommented:
:) You're very welcome.

Was I correct in thinking that your local (Production) version is slightly different than the file you provided (in the other question)?

Hence, I needed to comment-out some code in order to compile successfully, but the routines are actually present in your own version of the workbook?

Either way, I'm glad we (three) reached a solution together.
0
Bright01Author Commented:
Great Teamwork guys.  Appreciate the help..... I'll get this right sooner or later.  Your help is greatly appreciated.

B.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Applications

From novice to tech pro — start learning today.