Macro to adjust values in columns

[broro183]

hi,

Sorry I think it is my instruction that's causing the problem - the mismatch error means that it is trying to make a variable something other than what it is declared as.
(& I'm learning as I go now...

In this case, it seems that Excel is trying to make the inputbox response be VBCancel (?) when it is declared as Long.
I've taken the easy (& probably not the best) way out of this by allowing all the inputboxes to error (using on error resume next) and adjusting the checking code within the main sub.
The other option is to declare all the inputbox responses as variants & make a couple of other changes within the code.


Experts,
As I've just posted in the MS Excel community, do you have any suggestions/recommendations?
Should "StrPtr()" be placed in the function rather than the main macro?

(Also, I have an idea that we could use a 3D array (something like Rangename, RangeAddress, InputResponseforRange) for each range to allow the use of a "for each" construct, but have no idea how this could be done/if it would be worthwile.)
MS community post:
tbc...
edit: http://www.microsoft.com/communities...&lang=en&cr=US

Suggested Code:

Option Explicit

Private AmountToChangeSmallBy As Long 'Inputbox variable
Private AmountToChangeMediumBy As Long 'Inputbox variable
Private AmountToChangeLargeBy As Long 'Inputbox variable
Private SingleOpt_LocationsToExclude As String 'Inputbox variable
Private MultipleOpt_LocationsToExclude As String 'Inputbox variable
Private sma As Range, med As Range, lar As Range, TempCell As Range


Sub newModifiedPriceChanger()
Application.ScreenUpdating = False
Dim CurrentCell As Range
Dim ws As Worksheet
Dim LastDataRow As Long

Set CurrentCell = ActiveCell

Call FlexibilityViaInput

For Each ws In ThisWorkbook.Worksheets
    With ws
'    .Select
    
    'check that no rows are hidden
    On Error Resume Next
            .ShowAllData
    On Error GoTo 0
        
        LastDataRow = .Cells(Rows.Count, "A").End(xlUp).Row
        Set sma = .Range("F2:F" & LastDataRow)
        Set med = .Range("G2:G" & LastDataRow)
        Set lar = .Range("H2:H" & LastDataRow)
        Set TempCell = .Range("A" & LastDataRow + 1)
        
        'to change all constant numeric values in the visible rows of the sma & med ranges
        If StrPtr(AmountToChangeSmallBy) <> 0 And AmountToChangeSmallBy <> 0 Then
            Call GiveTempCellAValueAndChangeRange(AmountToChangeSmallBy, sma)
        Else
            MsgBox "No value was input therefore no changes will be made to the sma range", vbOKOnly
        End If
        
        If StrPtr(AmountToChangeMediumBy) <> 0 And AmountToChangeMediumBy <> 0 Then
            Call GiveTempCellAValueAndChangeRange(AmountToChangeMediumBy, med)
        Else
            MsgBox "No value was input therefore no changes will be made to the med range", vbOKOnly
        End If
        'Creation of a helper column to filter based on Col I values
            With .Range("L1:L" & LastDataRow)
                 .FormulaR1C1 = "=IF(OR(SUBSTITUTE(RC[-3],"" "","""")=" & Chr(34) & _
                 SingleOpt_LocationsToExclude & Chr(34) & ",RC[-3]=" & Chr(34) & _
                 MultipleOpt_LocationsToExclude & Chr(34) & "),""hide"",""show"")"
                
                'the below line has no error handling but may (?) need some if there are already filters on the sheet...
                .AutoFilter Field:=1, Criteria1:="show"
            End With
            
        'to adjust the lar range to only the constant numeric values in visible cells
        If StrPtr(AmountToChangeLargeBy) <> 0 And AmountToChangeLargeBy <> 0 Then
            Call GiveTempCellAValueAndChangeRange(AmountToChangeLargeBy, lar)
        Else
            MsgBox "No value was input therefore no changes will be made to the lar range", vbOKOnly
        End If
        
        'to remove the helper column & the temp cell
            .Range("L:L").Delete
            TempCell.ClearContents
    End With
Next ws
'to leave the activecell highlighted at end of macro
CurrentCell.Select

Set CurrentCell = Nothing
Set ws = Nothing
Set sma = Nothing
Set med = Nothing
Set lar = Nothing
Set TempCell = Nothing
Application.ScreenUpdating = True
End Sub

Private Sub FlexibilityViaInput()
'error code added to allow for the input boxes being cancelled
On Error Resume Next
'use of Input boxes to allow flexibility through user input
AmountToChangeSmallBy = InputBox("please insert the amount to change the ""Small"" values by" _
    & Chr(10) & "(eg to decrease by 2 enter ""-2"" or to increase enter ""2"")", _
    "AMOUNT TO CHANGE BY:")
AmountToChangeMediumBy = InputBox("please insert the amount to change the ""Medium"" values by" _
    & Chr(10) & "(eg to decrease by 2 enter ""-2"" or to increase enter ""2"")", _
    "AMOUNT TO CHANGE BY:")
AmountToChangeLargeBy = InputBox("please insert the amount to change the ""Large"" values by" _
    & Chr(10) & "(eg to decrease by 2 enter ""-2"" or to increase enter ""2"")", _
    "AMOUNT TO CHANGE BY:")
SingleOpt_LocationsToExclude = InputBox("please type the SingleOpt_Locations to exclude from the ""Large"" values being changed" _
    & Chr(10) & "(eg ""JB, OT"")", _
    "SingleOpt_Locations TO EXCLUDE")
MultipleOpt_LocationsToExclude = InputBox("please type the MultipleOpt_Locations to exclude from the ""Large"" values being changed" _
    & Chr(10) & "(eg ""JB, OT"")", _
    "MultipleOpt_Locations TO EXCLUDE")
On Error GoTo 0
End Sub

Private Sub GiveTempCellAValueAndChangeRange(ChangeAmount As Long, RangeToChange As Range)
'to create a temp cell value for paste special changes
    With TempCell
'.Select
        .Value = ChangeAmount
        .Copy
    End With
    With RangeToChange.SpecialCells(xlCellTypeConstants, 1).SpecialCells(xlCellTypeVisible)
'        .Select
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, _
            SkipBlanks:=False, Transpose:=False
    End With
End Sub

hth
Rob

[additude]

Thanks.

Is there a way to "reset" the error after it has displayed one MsgBox for one error of sma, med, lar because the message box appears multiple times.

I figure the "error()" is being processed for each iteration of updates for each of the 3 price columns.

I think reseting that "smaError()" or which ever one back to null would probably prevent multiple displays of the warning:

MsgBox "No value was input therefore no changes will be made to the sma range", vbOKOnly

Got any ideas?

Hummm...well after a bit more testing it doesn't appear that my idea of what was happening holds true. I don't know why the "No Value was entered" MsgBox appears twice for each time no value is entered...

Another thought...the MsgBox appears once for each worksheet in the workbook. There are two worksheets in this workbook.

Maybe it would be easier to label the MsgBox "No value was input therefore no changes will be made to the ThisWorkbook.Worksheets sma range"...just a thought, I haven't tried this yet. Maybe it wont let ThisWorkbook.Worksheets display...

I'm working on something like this, but can't get it to work:

MsgBox "No value was input therefore no changes will be made to the " & ThisWorkbook & "sma range", vbOKOnly

Onword and Upword...
I am close with this:

MsgBox "No value was input therefore no changes will be made to the " & ActivePage.Name & "sma range", vbOKOnly

The ActivePage is the selected worksheet, but I need the name of the worksheet that the macro is processing. Something like "CurrentPage.Name" although that object hasn't worked for me...

But something like that....

[broro183]

you're so close!

The ActivePage is the selected worksheet, but I need the name of the worksheet that the macro is processing. Something like "CurrentPage.Name" although that object hasn't worked for me...

Change the section "CurrentPage.Name" to "ws.name".


hth
Rob