Looking for way to ensure that cell B15 is always negative on all sheets.

[mikenelena]

I have a payroll spreadsheet that features a cell for deductions. I want to make sure that regardless of whether we enter a positive or a negative number in that cell, the number always reverts to negative. I found a code on extendoffice.com that works, but I have to add it to every sheet. I have about 30. The larger issue though, is that when we add a new employee, we'd have to remember to add the code to their their sheet also. I'd like to find a solution that works once and forever. I appreciate any ideas!

Here are 2 sections of code. The first was my attempt to solve the problem at the user form level. If I step through this code line by line with F8, it works. When the code runs inside the user form however, it skips the If Statement (red text), and leaves the number positive. I don't know why.

The 2nd code section is the one from extendoffice.com. It works, but is not especially practical for our circumstances. Thanks again to anyone willing to help out!

Private Sub Confirm_Btn_Click()


Dim Appraiser As String
Dim i As Long
Dim r As Long
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim mySheet As String


With Me.EmployeeList_Lstbox
    For i = 0 To .ListCount - 1
        If .Selected(i) Then         '<-----'This with block gets the appraiser selected in the listbox to try to match against the list on the "Generals" worksheet.
            Appraiser = .List(i)
            Exit For
        End If
    Next i
End With


If Appraiser = "" Then
    MsgBox "Please select an appraiser from the ListBox.", vbExclamation, "Appraiser Not Selected!"
    Exit Sub
End If


Set ws = Worksheets("Generals")


r = Application.Match(Appraiser, ws.Columns(1), 0) 'Matching the selected appraiser to one in the worksheet column.
mySheet = ws.Range("H" & r).Value                   ' This sets the appraiser's worksheet name in column H to a variable.  r is the row number.


Set ws2 = Sheets(mySheet)                       'Changing the string variable into a worksheet variable.


With ws2
.Range("B15").Value = Me.DeductionAmount_Txtbox.Text     'Setting the amount of the deduction into the appropriate cell.
.Range("D15").Value = Me.Description_txtbox.Text
End With


MsgBox "Deduction sucessfully applied."


[B][COLOR=#FF0000]If Range("B15").Value > 0 Then[/COLOR][/B]
[B][COLOR=#FF0000]
[/COLOR][/B]
[B][COLOR=#FF0000]    Range("B15").Value = Range("B15").Value * -1[/COLOR][/B]
[B][COLOR=#FF0000]End If[/COLOR][/B]


AddDeduction_Frm.Hide
CurrentPayroll_Frm.Show


End Sub

2nd Code...

Private Sub Worksheet_Change(ByVal Target As Range)
'This code ensures that deductions will be entered as negative numbers.
    Const sRg As String = "B15"
    Dim xRg As Range
    On Error GoTo err_exit:
    Application.EnableEvents = False
    If Not Intersect(Target, Range(sRg)) Is Nothing Then
        For Each xRg In Target
            If Left(xRg.Value, 1) <> "-" Then
                xRg.Value = xRg.Value * -1
            End If
        Next xRg
    End If
err_exit:
    Application.EnableEvents = True
End Sub

 

[JoeMo]

Based on what you've told us, I would think some Workbook_SheetChange event code is what you need. It's automatic and comprehends adding and/or removing employee sheets. Basically does for every sheet, what your 2nd code does for a specific sheet. Would you still consider that impractical? If so, why?

 

[mikenelena]

Joe,

Thanks for the suggestion. No, that sounds like something that could work. Although what I meant by "all" sheets, was all 'employee' sheets. There are a few sheets to which this should not apply. Is that possible?

Thanks!

 

[Fluff]

If you are only interested in cell B15, try

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'This code ensures that deductions will be entered as negative numbers.
   If Sh.Name = "[COLOR=#ff0000]master[/COLOR]" Or Sh.Name = "[COLOR=#ff0000]data[/COLOR]" Then Exit Sub
   On Error GoTo err_exit:
   Application.EnableEvents = False
   If Target.Address(0, 0) = "B15" Then
      If Left(Target.Value, 1) <> "-" Then
          Target.Value = Target.Value * -1
      End If
    End If
err_exit:
    Application.EnableEvents = True
End Sub

Change sheet names in red to suit & add mores as needed. These are the sheets the code should NOT run on.