Controlling the decimal places on other Sheets

Hi,

The (This)Workbook code module offers an event similar to the Worksheet_Change() event, but is a "catch all" routine that will be called whenever any worksheet within the workbook is changed:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

End Sub


I would suggest moving Marty's code from the local worksheet, [Currency], & slightly modifying it within the Workbook_SheetChange(...) event to cater for more than one worksheet, as I have indicated below.

I have also replaced the reference to "Me." to "Sh." (the parameter that refers to the individual worksheet object that has changed):

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

  Dim rFind As Range
  Dim rStep As Range
  Dim sSheet As String
  Dim sRange As String
  Dim strNF As String

  Dim SelectedCurrency                                  As String
  Dim CurrencyList                                      As String
  Dim ChangeCellStart                                   As String
  
  Select Case (UCase$(Sh.Name))
  
      Case ("CURRENCY")
          SelectedCurrency = "D4"
          CurrencyList = "B4:B12"
          ChangeCellStart = "E4"
          
     Case ("CUSTOMER DATA")
          SelectedCurrency = "..."                      ' *** CHANGE THIS
          CurrencyList = "..."                          ' *** CHANGE THIS
          ChangeCellStart = "..."                       ' *** CHANGE THIS
          
     Case Else
         Exit Sub
         
  End Select

  If Target.Cells.Count > 1 Then
     Exit Sub
  End If
  
  If Target.Address = Sh.Range(SelectedCurrency).Address Then
     Set rFind = Sh.Range(CurrencyList).Find(What:=Target.Value, LookAt:=xlWhole)
     
     If Not rFind Is Nothing Then
        For Each rStep In Sh.Range(Sh.Range(ChangeCellStart), Sh.Cells(Sh.Rows.Count, Sh.Range(ChangeCellStart).Column).End(xlUp))
            
            On Error Resume Next
            
            If InStr(1, rStep.Value, "!") = 0 Then
               Sh.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 Right(sSheet, 1) = "'" Then
                  sSheet = Left(sSheet, Len(sSheet) - 1)
               End If
               
               If sRange = "C9" Then                    ' *** CHECK THIS!!!
                  strNF = rFind.Offset(0, 1).NumberFormat
               Else
                  strNF = Replace(rFind.Offset(0, 1).NumberFormat, ".00", "")
               End If
               
               ThisWorkbook.Worksheets(sSheet).Range(sRange).NumberFormat = strNF
            End If
            
            On Error GoTo 0
            
        Next rStep
     End If
  End If
  
End Sub

Select allOpen in new window

Please note the three statements I have suffixed with the in-line comment ' *** CHANGE THIS.

Also, the single statement I have suffixed with the comment ' *** CHECK THIS!!!.


BFN,

fp.

fp,

Thanks for jumping in here.  I've been looking over this code and have a few questions.  What do I put in on the lines  *** CHANGE THIS?  

Let me be more specific about what this code does.  When I change the Currency on the Currency Sheet, it changes all of the identified cells in the Workbook I have.  The problem I had then was that I have numbers that span from $.07 to $5,600,000 and so I used Marty's code to identify where I have cells that need to be treated as currency (which you select at the beginning) and need two decimal places.

Hopefully that's what you realized with the code I provided.

So I have moved Marty's code to This Worksheet and am now comparing your and his code to see how I make yours work.  This is where I'm challenged.  

1.) So do I make "A Case" for each worksheet I want to have a cell changed on?
2.) Do I need to modify the ***CHECK THIS Statement?

A little detail would help out here.

Thank you,

B.

I've been trying to work with this but am still confused.  How does the Macro know which cells to change on which Worksheet?  Is it in the;

CASE ID?

Case ("CUSTOMER DATA")
          SelectedCurrency = "..."                      ' *** CHANGE THIS
          CurrencyList = "..."                          ' *** CHANGE THIS
          ChangeCellStart = "..."                       ' *** CHANGE THIS
         
If so, do I need to identify each sheet where the cells are going to be affected as I did on the original code with my line;

If sRange = "C18,c25,c36,c52,c59,c68,c75,c83,c94,c101" Then

?

I'll keep trying.......

B.

The attached workbook contains this modified code. To add more sheets you just need to add a new cell value in sheet Currency, column E as I have done and add a new Case statement as in lines 23 and 24 for any other sheet.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rFind As Range, rStep As Range
    Dim sSheet As String, sRange As String
    Dim strNF As String
    Dim strCell 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)
                    Select Case sSheet
                        Case "Customer - Inputs"
                            strCell = "C9"
                        Case "Customer Data"
                            strCell = "E10"
                    End Select
                    If sRange = strCell Then
                        strNF = rFind.Offset(0, 1).NumberFormat
                    Else
                        strNF = Replace(rFind.Offset(0, 1).NumberFormat, ".00", "")
                    End If
                    ThisWorkbook.Worksheets(sSheet).Range(sRange).NumberFormat = strNF
                End If
                On Error GoTo 0
            Next rStep
        End If
    End If
End Sub

Select allOpen in new window

Q-28264436.xlsm

Marty,

The code works great.  However, when I put it in my production WB, it doesn't respect the decimal part of the macro for some reason..... it gives me all two digit numbers.  I can live with that; however, in trying to trouble shoot it the only thing that I can find that is different with your code and my full WB is that I have multiple cell references;

EXAMPLE:   Instead of "C9", I would have "C9, C12, C15, C18, C30".  

So I'm wondering if it could be the difference between having a statement;

StrCell and having a StrRange........

Any final ideas here that I may trouble shoot?

Otherwise, your code works perfectly.

B.

The cells specified in the Case statement shown below from the Currency sheet's Worksheet_Change event are the ones that get the number formatting with decimals. Any other cell(s) in the 'Change Field Table' get whole numbers.

                        Case "Customer - Inputs"
                            strCell = "C9"
                        Case "Customer Data"
                            strCell = "E10"

Select allOpen in new window

So since that table looks like this

Change Field Table
'Customer - Inputs!C9
'Customer - Inputs!C11
 Customer Data!E10

Customer - Inputs cell C9 get's the decimal formatting but C11 gets the whole number formatting. In the case of the Customer Data sheet E10 gets the decimal formatting and if you want some other cell to get the whole number formatting you need to add it to the table like so

Change Field Table
'Customer - Inputs!C9
'Customer - Inputs!C11
 Customer Data!E10
 Customer Data!E12

where E12 would be formatted as a whole number.

So what if I wanted multiple cells to get the decimal format on the same WS?  Such as the case with C9 which is already configured, but add C11 and C16 in the Customer - Input WS?

                        Case "Customer - Inputs"
                            strCell = "C9"

would it be:       strCell = "C9, C11, C16"
                                         

B.

No that wouldn't work. As written, IMO, the whole process is awkward. Give me a little while and let me see if I can come up with something that's easier to maintain.

Marty,

Your code works flawlessly.  I however, have made a big mistake in my conversation with you and didn't realize it until I started putting your code into my WB.

Here's the problem, FanPages (FP) was kind enough to give me some additional code, from your original, that allowed for me to have the selection of currency on the "Customer - Input" WS.  In order to do so, he advised that I had to move the code in "Currency" to the Customer - Input" WS and make the modifications that FP suggested.  I did it and it worked well, but still had the problem with the decimal points  (it did not work by changing any cells to whole numbers.  When I got your new fix with the improvements, it had the selection still being made on the original Currency WS without FP's changes to accommodate the requirement for the new location of the selection of currency.

Now, I don't know how to fix it.  Do I take your code and simply try to refer the selection of Currency to the Customer - Input WS or do I take what FP delivered and try to add your additions?  I've tried that but it's broken completely down.  I tried to move your code over and add his additions and again..... no luck.  

I am so sorry for this confusion.  I have two choices;

1.) Simply author another question and build off what you have sent me; requesting that the Currency Selection gets moved to the "Customer - Input" tab, or continue to try to fix FP's code by integrating your new design.  Any advise would be much appreciated.

Here is FP's code changes to handle the move of that one cell, that I now have in the "Customer - Input" WS:

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

Post your workbook and I'll fix it.

Marty,

I'm closing out this question.  You did a fabulous job on getting my question answered and I appreciate it.  I'll be authoring another question that may simplify my request by taking what you have already done and moving the request for currency to a specific cell on the Customer - Input WS.  You did everything I asked and then some and it is only fair that I author another question to get the result I need for my production WB.  

Thank you again, and I hope you will pick up the next Question.

All the best,

B.