Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.
Sub Multiply_Range()
Dim dblMultiplier As Double
' This is required in case cancel is clicked.
On Error GoTo UserCancelled
'get multiplier
dblMultiplier = InputBox("Enter Multiplier", "Range Multiplication", 1000)
Multiply_Range_Function dblMultiplier
UserCancelled:
End Sub
Private Sub Multiply_Range_Function(dblMultiplier As Double)
'This macro multiplies all values in a range by the user-entered multiplier
Dim rngToMultiply As range
Dim intColCount As Long, intRowCount As Long
Dim strCalc As String
strCalc = application.Calculation
application.Calculation = xlCalculationManual
' Assign selection to object variable
Set rngToMultiply = selection
' Loop through source range multiplying all value-containing cells and _
painting the formula-containing cells blue
Dim cl As range
' Loop through source range assigning any formulae found
' to the equivalent cell of the destination range.
For Each cl In rngToMultiply.Cells
If cl.HasFormula Then
cl.Interior.ColorIndex = 5
Else
If Not cl = "" Then cl = cl.Value * dblMultiplier
End If
Next
UserCancelled:
application.Calculation = strCalc
End Sub
Sub Divide_Range()
Dim rngToDivide As range
Dim dblDivider As Double
Dim strCalc As String
Dim intColCount As Long, intRowCount As Long
strCalc = application.Calculation
application.Calculation = xlCalculationManual
' Assign selection to object variable
Set rngToDivide = selection
' This is required in case cancel is clicked.
' Type 8 input box returns a range object if OK is
' clicked or False if cancel is clicked. I do not
' know of a way to test for both cases without
' using error trapping
On Error GoTo UserCancelled
' Assign object variable to user-selected cell
dblDivider = InputBox("Enter Divider", "Range Division", 1000)
If dblDivider = 0 Then
MsgBox ("Cannot divide by zero, sorry!")
Exit Sub
End If
Dim cl As range
' Loop through source range assigning any formulae found
' to the equivalent cell of the destination range.
For Each cl In rngToDivide.Cells
If cl.HasFormula Then
cl.Interior.ColorIndex = 5
Else
If Not cl = "" Then cl = cl.Value / dblDivider
End If
Next
UserCancelled:
application.Calculation = strCalc
End Sub
Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.
Have a better answer? Share it in a comment.
Join the community of 500,000 technology professionals and ask your questions.