nocturnald
10-25-2017, 03:38 AM
Hi everyone,
Can someone please help me? I'm currently trying to get VBA to select certain cells and then multiple them out.
Its currently working with ranges but not when I'm trying to do multiple single cells.
I'm not sure what I'm doing wrong.
Im currently getting a #value when im trying to multiple it out.
Sub pricepercincrease()
Dim priceincrease, percentage As Variant
Dim r1, r2, wrange As Range
Dim selecttab As String
Dim promptmsgbox As Integer
On Error GoTo errorend
percentage = InputBox("Please enter the percentage you wish to increase by?", "Price Increase")
priceincrease = (percentage / 100) + 1
selecttab = InputBox("Please select a worksheet to increase?" & vbNewLine & vbNewLine & "1. Discounts C&P" & vbNewLine & "2. Finishing" & vbNewLine & "3. Air Valves & Circulars" & vbNewLine & "4. Ceiling Diffusers" & vbNewLine & "5. Ceiling Swirls" & vbNewLine & "6. Displacement Vents" & vbNewLine & "7. Fireblocks & PSG" & vbNewLine & "8. Floor Grilles" & vbNewLine & "9. Floor Diffusers & Swirls" & vbNewLine & "10. High Induction Slots" & vbNewLine & "11. Jet & Cylinder" & vbNewLine & "12. Laminar Flow Panels" & vbNewLine & "13. Linear Bar Grilles" & vbNewLine & "14. Linear Fixed Ceiling Diffuser" & vbNewLine & "15. Linear Slot Diffusers" & vbNewLine & "16. Louvres" & vbNewLine & "17. OBD" & vbNewLine & "18. Plenums" & vbNewLine & "19. Security Grilles" & vbNewLine & "20. Wall Grilles" & vbNewLine & "21. Contract Diffuser Range" & vbNewLine & "22. Fixings" & vbNewLine & "23. TEST", "Tab Increase")
Select Case selecttab
'1. Discounts C&P
Case 1
promptmsgbox = MsgBox("This is will update Discounts C&P by " & percentage & "%", vbCritical + vbYesNo + vbDefaultButton2, "Continue?")
If promptmsgbox = vbYes Then
'********************************************************************
'WORKS FOR RANGE BUT NOT SINGLE CELLS
Set wrange = ThisWorkbook.Worksheets("Test").Range("H21, H23, H25")
'TESTING TO SELECT A RANGE USING UNISON INSTEAD
'Set r1 = ThisWorkbook.Worksheets("TEST").Range("H21:H25")
'Set r2 = ThisWorkbook.Worksheets("TEST").Range("G21:G28")
'Set wrange = Union(r1, r2)
ThisWorkbook.Worksheets("TEST").Select
'********************************************************************
'MsgBox (wrange)
MsgBox (percentage)
MsgBox (priceincrease)
Else
Exit Sub
End If
'multiples out the percentage against the range
wrange = Evaluate(wrange.Address & "*" & priceincrease)
'roundsup all ranges to two decimals places
For Each cell In wrange
cell.Value = WorksheetFunction.Round(cell.Value, 2)
Next cell
'selects format display to two decimal places
Selection.NumberFormat = "0.00"
wrange.Select
Exit Sub
errorend:
MsgBox ("An error has occured when trying to increase " & selectab)
End Sub
Can someone please help me? I'm currently trying to get VBA to select certain cells and then multiple them out.
Its currently working with ranges but not when I'm trying to do multiple single cells.
I'm not sure what I'm doing wrong.
Im currently getting a #value when im trying to multiple it out.
Sub pricepercincrease()
Dim priceincrease, percentage As Variant
Dim r1, r2, wrange As Range
Dim selecttab As String
Dim promptmsgbox As Integer
On Error GoTo errorend
percentage = InputBox("Please enter the percentage you wish to increase by?", "Price Increase")
priceincrease = (percentage / 100) + 1
selecttab = InputBox("Please select a worksheet to increase?" & vbNewLine & vbNewLine & "1. Discounts C&P" & vbNewLine & "2. Finishing" & vbNewLine & "3. Air Valves & Circulars" & vbNewLine & "4. Ceiling Diffusers" & vbNewLine & "5. Ceiling Swirls" & vbNewLine & "6. Displacement Vents" & vbNewLine & "7. Fireblocks & PSG" & vbNewLine & "8. Floor Grilles" & vbNewLine & "9. Floor Diffusers & Swirls" & vbNewLine & "10. High Induction Slots" & vbNewLine & "11. Jet & Cylinder" & vbNewLine & "12. Laminar Flow Panels" & vbNewLine & "13. Linear Bar Grilles" & vbNewLine & "14. Linear Fixed Ceiling Diffuser" & vbNewLine & "15. Linear Slot Diffusers" & vbNewLine & "16. Louvres" & vbNewLine & "17. OBD" & vbNewLine & "18. Plenums" & vbNewLine & "19. Security Grilles" & vbNewLine & "20. Wall Grilles" & vbNewLine & "21. Contract Diffuser Range" & vbNewLine & "22. Fixings" & vbNewLine & "23. TEST", "Tab Increase")
Select Case selecttab
'1. Discounts C&P
Case 1
promptmsgbox = MsgBox("This is will update Discounts C&P by " & percentage & "%", vbCritical + vbYesNo + vbDefaultButton2, "Continue?")
If promptmsgbox = vbYes Then
'********************************************************************
'WORKS FOR RANGE BUT NOT SINGLE CELLS
Set wrange = ThisWorkbook.Worksheets("Test").Range("H21, H23, H25")
'TESTING TO SELECT A RANGE USING UNISON INSTEAD
'Set r1 = ThisWorkbook.Worksheets("TEST").Range("H21:H25")
'Set r2 = ThisWorkbook.Worksheets("TEST").Range("G21:G28")
'Set wrange = Union(r1, r2)
ThisWorkbook.Worksheets("TEST").Select
'********************************************************************
'MsgBox (wrange)
MsgBox (percentage)
MsgBox (priceincrease)
Else
Exit Sub
End If
'multiples out the percentage against the range
wrange = Evaluate(wrange.Address & "*" & priceincrease)
'roundsup all ranges to two decimals places
For Each cell In wrange
cell.Value = WorksheetFunction.Round(cell.Value, 2)
Next cell
'selects format display to two decimal places
Selection.NumberFormat = "0.00"
wrange.Select
Exit Sub
errorend:
MsgBox ("An error has occured when trying to increase " & selectab)
End Sub