Change cell to negative Value

[cajand]

Hello,

I use the below code to change the cell value from positive to negative.
You click the cells you wanna change to negative.

However, I want to adjust it so that if I click on a cell between columns N to W
I want it to change the cells on the same row in column Q and R, not the actual cell you click.

Is this possible?

   End If

     
    
    End Sub
    
    Sub ChangeToNegative()
    
    Dim rng As Range
    Dim WorkRng As Range
    On Error Resume Next
    xTitleId = "Kalkyl"
    
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Markera de celler du vill retunera/ta bort:", 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

[JOHN H. DAVIS]

Maybe?

Sub cajand()
    Dim rng As Range
    Dim WorkRng As Range
    On Error Resume Next
    xTitleId = "Kalkyl"
    
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Markera de celler du vill retunera/ta bort:", xTitleId, WorkRng.Address, Type:=8)
    Set WorkRng = WorkRng.SpecialCells(xlCellTypeConstants, xlNumbers)
    For Each rng In WorkRng
    If rng.Column > 13 And rng.Column < 24 Then
    xValue = Cells(rng.Row, "Q").Value
    If xValue > 0 Then
    Cells(rng.Row, "Q").Value = xValue * -1
    End If
    yValue = Cells(rng.Row, "R").Value
    If yValue > 0 Then
    Cells(rng.Row, "R").Value = yValue * -1
    End If
    End If
    Next
End Sub

[cajand]

Maybe?

Sub cajand()
    Dim rng As Range
    Dim WorkRng As Range
    On Error Resume Next
    xTitleId = "Kalkyl"
    
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Markera de celler du vill retunera/ta bort:", xTitleId, WorkRng.Address, Type:=8)
    Set WorkRng = WorkRng.SpecialCells(xlCellTypeConstants, xlNumbers)
    For Each rng In WorkRng
    If rng.Column > 13 And rng.Column < 24 Then
    xValue = Cells(rng.Row, "Q").Value
    If xValue > 0 Then
    Cells(rng.Row, "Q").Value = xValue * -1
    End If
    yValue = Cells(rng.Row, "R").Value
    If yValue > 0 Then
    Cells(rng.Row, "R").Value = yValue * -1
    End If
    End If
    Next
End Sub

This works perfectly! Thank you!

[JOHN H. DAVIS]

You're welcome. Glad to help out and thanks for the feedback.