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:
But the problem is that this will require a user's interaction.
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.
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.
So only if there is text in the cells
C5:C143, then the cells
F5:F143should be negative numbers
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
C144 - so anything between these two text cells in column
F would be a negative number?
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