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 Set wrange = ThisWorkbook.Worksheets("Test").Range("H21, H23, H25") MsgBox (percentage) MsgBox (priceincrease) For Each cell In wrange cell.Value = WorksheetFunction.Round(cell.Value * priceincrease, 2) cell.NumberFormat = "0.00" Next cell wrange.Select End If End Select Exit Sub errorend: MsgBox ("An error has occured when trying to increase " & selectab) End Sub