VBA - Change Numbers in Variable Range to Negative

I want to have a column in my worksheet changed to negative numbers as this column represents "stock out".

I got code from the below link which will change the values of a given range to negative:

https://www.extendoffice.com/documents/excel/677-excel-change-positive-numbers-to-negative.html

But the problem is that this will require a user's interaction.

Code:

Sub ChangeToNegative()
    'Updateby20131113
    Dim rng As Range
    Dim WorkRng As Range

    On Error Resume Next

    xTitleId = "KutoolsforExcel"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    Set WorkRng = WorkRng.SpecialCells(xlCellTypeConstants, xlNumbers)

    For Each rng In WorkRng
        xValue = rng.Value
        If xValue > 0 Then
            rng.Value = xValue * -1
        End If
    Next
End Sub

I then found out to put the code in the worksheet itself and name the sub Change(ByVal Target As Range) which will update the selected range as you use it.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim WorkRng As Range
    On Error Resume Next

    Set WorkRng = Application.Selection
    Set WorkRng = WorkRng.SpecialCells(xlCellTypeConstants, xlNumbers)

    If Target.Address = WorkRng Then     
        For Each rng In WorkRng
            xValue = rng.Value
            If xValue > 0 Then
                rng.Value = xValue * -1
            End If
        Next 
    End If
End Sub

This works great, but it then means that whichever cell I click on and type in numbers, it will be a negative.

So instead of using Application.Selection, I want to give it a specific range - but one that could change.

  1. So only if there is text in the cells C5:C143, then the cells F5:F143 should be negative numbers

  2. If I delete any cells between the C5:C143, then the range should be updated accordingly.

Perhaps the range could be based on text in C4 and C144 - so anything between these two text cells in column F would be a negative number?

1 answer

  • answered 2018-10-16 11:08 Darren Bartrup-Cook

    I've added plenty of comments to explain what the code does.

    Private Sub Worksheet_Change(ByVal Target As Range)
    
        Dim WorkRng As Range
        Dim RangeToCheck As Range
        Dim rCell As Range
    
        'Don't Resume Next - if an error occurs handle it properly
        'and don't just hope the code can carry on regardless.
        On Error GoTo Err_Handle
    
        'This is the range we're looking at.
        'Use a named range so the range will update if you add/remove cells.
        Set RangeToCheck = Union(Range("Column_C_Figures"), Range("F5:F143"))
    
        'Are any cells within the required range?
        If Not Intersect(Target, RangeToCheck) Is Nothing Then
    
            'The cell will be updated, so disable events so
            'Worksheet_Change doesn't fire a second time.
            Application.EnableEvents = False
    
            'Look at each cell in Target.
            'More than one cell could change if values pasted in, or row deleted, or....
            For Each rCell In Target
                'All values in Target may not be in RangeToCheck so only look at
                'the ones that are.
                If Not Intersect(rCell, RangeToCheck) Is Nothing Then
                    If IsNumeric(rCell) And rCell > 0 Then
                        rCell = rCell * -1
                    End If
                End If
            Next rCell
    
        End If
    
    Fast_Exit:
    
        Application.EnableEvents = True
    
    Exit Sub
    
    Err_Handle:
        'Deal with any errors and resume so that events are re-enabled.
        Select Case Err.Number
            'Case 13 'Example of error that may occur.
                'Deal with a data type mismatch and either
                'Resume, Resume Next or Resume Fast_Exit.
            Case Else
                Resume Fast_Exit
        End Select
    
    End Sub