Need help to change figure from positive to negative

[spycein]

Hello everyone,
I am working on a VBA code which changes positive figures to negative figures and vice versa.
The code works fine if i select more than 1 cells but if i select only one cell to change the figure from positive to negative or negative to positive then all other numbers get changed automatically in the sheet.

The code is as follows

Sub PlusMinus()
'Changes the sign on a selected range of numbers
Dim cell As Range
If Application.Count(Selection.Cells) = 0 Then
MsgBox "Non Numeric Data", vbOKOnly + vbExclamation, "Cannot Change Figures"
Exit Sub
End If
On Error Resume Next 'copies with cells that are not numeric
For Each cell In Selection.SpecialCells(xlCellTypeConstants, 23)
cell.Value = -cell.Value
Next cell
End Sub


I was also looking for a way to incorporate in the code which would ask for the range and then change the figures.
For example, if i need to change any number, i need to click the command button which would assigned with macro.
on clicking command button, a pop up message box should appear and ask for the range selection.
The figure should change from positive to negative or vice versa Once i select the range or a single cell and select OK button.


I hope i explained my query properly.

Thank you so much in advance.

Best Regards

 

[Joe4]

See if this does what you want:

Sub PlusMinus()
'Changes the sign on a selected range of numbers

    Dim myEntry As String
    Dim myRange As Range
    Dim cell As Range
    
'   Ask for range
    On Error GoTo err_chk
    myEntry = InputBox("Enter range", "DATA ENTRY")
    Set myRange = Range(myEntry)
        
    On Error Resume Next 'copies with cells that are not numeric
    Select Case myRange.Cells.CountLarge
        Case 1
            If Not (myRange.HasFormula) Then
                myRange.Value = -myRange.Value
            End If
        Case Else
            For Each cell In myRange.SpecialCells(xlCellTypeConstants, 23)
                cell.Value = -cell.Value
            Next cell
    End Select
    On Error GoTo 0
        
    Exit Sub
    
err_chk:
    If Err.Number = 1004 Then
        MsgBox "Please try again", vbOKOnly, "INVALID RANGE ENTRY!"
    Else
        MsgBox Err.Number & ":" & Err.Description
    End If
        
End Sub

 

[spycein]

See if this does what you want:

Sub PlusMinus()
'Changes the sign on a selected range of numbers

    Dim myEntry As String
    Dim myRange As Range
    Dim cell As Range
 
'   Ask for range
    On Error GoTo err_chk
    myEntry = InputBox("Enter range", "DATA ENTRY")
    Set myRange = Range(myEntry)
     
    On Error Resume Next 'copies with cells that are not numeric
    Select Case myRange.Cells.CountLarge
        Case 1
            If Not (myRange.HasFormula) Then
                myRange.Value = -myRange.Value
            End If
        Case Else
            For Each cell In myRange.SpecialCells(xlCellTypeConstants, 23)
                cell.Value = -cell.Value
            Next cell
    End Select
    On Error GoTo 0
     
    Exit Sub
 
err_chk:
    If Err.Number = 1004 Then
        MsgBox "Please try again", vbOKOnly, "INVALID RANGE ENTRY!"
    Else
        MsgBox Err.Number & ":" & Err.Description
    End If
     
End Sub

Thank you so much @Joe4.
This works Fine. But i cannot select the range with mouse, i need to type the range or cell reference value on the input box.
Could you please advice on this.
Best Regards,

 

[Joe4]

But i cannot select the range with mouse, i need to type the range or cell reference value on the input box.

OK, that wasn't quite clear from your initial post:

I was also looking for a way to incorporate in the code which would ask for the range and then change the figures.

I thought because you original was already running on a selected range, you wanted them to type it instead.

Try this version, which will allow you to select a range mid-macro:

Sub PlusMinus()
'Changes the sign on a selected range of numbers

    Dim myRange As Range
    Dim cell As Range
    
'   Ask for range
    On Error GoTo err_chk
    Set myRange = Application.InputBox("Select a range", "GET RANGE", Type:=8)
         
    On Error Resume Next 'copies with cells that are not numeric
    Select Case myRange.Cells.CountLarge
        Case 1
            If Not (myRange.HasFormula) Then
                myRange.Value = -myRange.Value
            End If
        Case Else
            For Each cell In myRange.SpecialCells(xlCellTypeConstants, 23)
                cell.Value = -cell.Value
            Next cell
    End Select
    On Error GoTo 0
        
    Exit Sub
    
err_chk:
    If Err.Number = 1004 Then
        MsgBox "Please try again", vbOKOnly, "INVALID RANGE ENTRY!"
    Else
        MsgBox Err.Number & ":" & Err.Description
    End If
        
End Sub

 

[spycein]

OK, that wasn't quite clear from your initial post:

I thought because you original was already running on a selected range, you wanted them to type it instead.

Try this version, which will allow you to select a range mid-macro:

Sub PlusMinus()
'Changes the sign on a selected range of numbers

    Dim myRange As Range
    Dim cell As Range
   
'   Ask for range
    On Error GoTo err_chk
    Set myRange = Application.InputBox("Select a range", "GET RANGE", Type:=8)
        
    On Error Resume Next 'copies with cells that are not numeric
    Select Case myRange.Cells.CountLarge
        Case 1
            If Not (myRange.HasFormula) Then
                myRange.Value = -myRange.Value
            End If
        Case Else
            For Each cell In myRange.SpecialCells(xlCellTypeConstants, 23)
                cell.Value = -cell.Value
            Next cell
    End Select
    On Error GoTo 0
       
    Exit Sub
   
err_chk:
    If Err.Number = 1004 Then
        MsgBox "Please try again", vbOKOnly, "INVALID RANGE ENTRY!"
    Else
        MsgBox Err.Number & ":" & Err.Description
    End If
       
End Sub

Thank you so much @Joe4
Works perfectly as i wanted.
Best Regards,

 

[Joe4]

You are welcome.