Changing a positive numeric cell input into a negative numeric value in the same cell based on criteria in another cell

2
votes

I want to change a positive value cell input in a range to a negative value by reference to a criteria in another cell range. So for instance cell range A1:A10 contains either a value of "B" or "S". Cell range B1:B10 is where the numeric values are entered. These values when entered are either made positive or negative values depending on the data already entered in corresponding cells A1:A10. So entering any value whether positive or negative in say B1 as either 1234 or -1234 where A1 has a value "B" will result in B1 displaying -1234. Conversely where any value whether positive or negative is input in Cells B1:B10 and the value of the corresponding row in column A is "S" the value in column B will always be positive irrespective of whether the original input was negative or positive.

If there is no value in a particular cell in the range A1:A10 corresponding to the same row in column B then a message should be displayed to the user saying "Please enter a value in the corresponding row in column A.

I am a complete novice to VBA coding and so far looking at other posts have cobbled together following code, but I do not know how to complete it to work successfully.

Any help would be very much appreciated.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A1 As Range
    Set A1 = Range("A1:A10")
    Dim A2 As Range
    Set A2 = Range("B1:B10")
    If Intersect(Target, A2) Is Nothing Then Exit Sub
    If IsText(Target, A1) Then
        If A1 = "S" Then
        Application.EnableEvents = False
            B1 = -B1
        Application.EnableEvents = True
    End If
End Sub
2
excelvbanegative-number
A1 is an entire range of cells, so the comparison A1 = "S" doesn't make sense. A 10-element range isn't a string. Look into Range.Find() if you want to find if "S" is in the range. Alternatively, loop over the cells in that range, comparing each one in turn with "S". Also, your IsText doesn't make sense. For one thing, that is a worksheet function, not a VBA function. For another thing, it takes one argument, not two. - John Coleman

2 Answers

1
votes

This should be what you need:

The For loop allows you to change more than one column B value at a time.
If the column A value is neither of "B" or "S", no action is taken.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim B As Range, Intersection As Range, cell As Range
    Dim v As String
    Set B = Range("B1:B10")
    Set Intersection = Intersect(Target, B)

    If Intersection Is Nothing Then Exit Sub

    Application.EnableEvents = False
        For Each cell In Intersection
            v = cell.Offset(0, -1).Value
            If v = "B" Then
                cell.Value = -Abs(cell.Value)
            ElseIf v = "S" Then
                cell.Value = Abs(cell.Value)
            End If
        Next cell
    Application.EnableEvents = True
End Sub
0
votes

An In-Place Worksheet Change

  • Copy the whole code into a sheet module (e.g. Sheet1).
  • The code does everything automatically, nothing to run here.
  • The function 'gets' the column range starting from the cell in FirstRow to the last non-empty cell.
  • The code automatically modifies the value that is entered in column B depending on the value in column A.

The Code

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Const Proc As String = "Worksheet_Change"
    On Error GoTo cleanError

    Const FirstRow As Long = 1
    Dim Criteria As Variant: Criteria = Array("S", "B", "")
    Dim Cols As Variant: Cols = Array(1, 2) ' or Array("A", "B")

    Dim rngS As Range: Set rngS = getColumnRange(Me, Cols(1), FirstRow)
    If rngS Is Nothing Then Exit Sub
    Dim rngT As Range: Set rngT = Intersect(Target, rngS)
    If rngT Is Nothing Then Exit Sub
    Dim ColOffset As Long
    ColOffset = Columns(Cols(0)).Column - Columns(Cols(1)).Column

    Application.EnableEvents = False
    Dim cel As Range
    For Each cel In rngT.Cells
        Select Case cel.offset(, ColOffset).Value
            Case Criteria(0): cel.Value = Abs(cel.Value)
            Case Criteria(1): cel.Value = -Abs(cel.Value)
            Case Criteria(2): cel.Value = "Please enter a value into cell '" _
              & cel.offset(, ColOffset).Address(0, 0) & "'."
            Case Else ' Maybe the same as the previous!?
        End Select
    Next

CleanExit:
    Application.EnableEvents = True

Exit Sub

cleanError:
    MsgBox "An unexpected error occurred in '" & Proc & "'." & vbCr _
       & "Run-time error '" & Err.Number & "':" & vbCr _
       & Err.Description, vbCritical, Proc & " Error"
    On Error GoTo 0
    GoTo CleanExit

End Sub

Function getColumnRange(Sheet As Worksheet, _
                        ByVal AnyColumn As Variant, _
                        Optional ByVal FirstRow As Long = 1) _
         As Range
    Dim rng As Range
    Set rng = Sheet.Columns(AnyColumn).Find("*", , xlValues, , , xlPrevious)
    If rng Is Nothing Then Exit Function
    If rng.Row < FirstRow Then Exit Function
    Set getColumnRange = Sheet.Range(Sheet.Cells(FirstRow, AnyColumn), rng)
End Function