For each loop applying to all values instead of > $20.00

**Marvelous** · 06-15-2021, 08:33 AM

Good morning (or evening) Excel/VBA wizards,

I am trying search through all sheets in a Workbook Price List and find all cells with prices (by cell formatting - see code below) AND the cell value is greater than 20 then add a price increase and roundup to the nearest dollar. Otherwise, if the price is less than $20, add the price increase and use the Ceiling formula to round to the nearest nickel. I would like for all prices that are over $20.00 and were increased to be formatted red, if less than $20 and increased than formatted green. A colleague sent me a UserForm that they use to increase prices but it was designed to increase all values by one amount. I do not really understand how to apply an if statement to a For each loop so first, I tried modifying the Macro by adding

And Cell.Value > 20

and thought I would run the macro twice and just change the ">20" to "<20" but even the prices that are <20 were increased and formatted red. So below on the left is what I am ultimately trying to achieve.
2021-06-15 07_22_42-Clipboard.png. Please see below complete code and attached workbook. Thanks in advance.

Public Sub PercentIncrease()
    
    Dim wS As Worksheet
    Dim Cell As Range
    Dim inputMsg As String
    
    Do
        x = InputBox("Please enter price increase or currency conversion: ", "Price Conversion")
    Loop While Not IsNumeric(x)
    
    inputMsg = "Please enter rounding: " & vbCr
    inputMsg = inputMsg & "0 = Nearest $" & vbCr
    inputMsg = inputMsg & "2 = Nearest Nickel"
    Do
        y = InputBox(inputMsg, "Rounding")
    Loop While (y <> 0 And y <> 0.05)
        
    For Each wS In ActiveWindow.SelectedSheets
        
        For Each Cell In wS.Range("A1:Y105")
            If Cell.NumberFormat = "\$0" Or Cell.NumberFormat = "\$#,##0" Or Cell.NumberFormat = "\$#,##0.00" Or Cell.NumberFormat = "\$0.00" Or Left(Cell.NumberFormat, 1) = "$" And _
            Cell.Font.Bold = True And _
            IsNumeric(Cell.Value) And _
            Cell.Value > 20 _
            Then Cell.Value = Application.WorksheetFunction.RoundUp(Cell.Value * x, y): Cell.Interior.Color = 255
            'Then Cell.Value = Application.WorksheetFunction.Ceiling(Cell.Value * x, y): Cell.Interior.Color = vbGreen
            On Error GoTo ErrorHandler
            Next Cell
        
    Next wS
    MsgBox "Done"
    Exit Sub
ErrorHandler:
    MsgBox wS.Name & "!" & Cell.Address
    Exit Sub
End Sub

Marvelous (not so much in vba!)

**dangelor** · 06-15-2021, 12:30 PM

Possibly...

Option Explicit

Sub Test()
    Dim dbPercentIncrease As Double, dbRoundupAmount As Double
    Dim ws As Worksheet, rg As Range, c As Range
    Dim lConfirm As Long

    Do
        dbPercentIncrease = Application.InputBox( _
                            Prompt:="Please enter the percentage of the price increase", _
                            Title:="Price Increase %", _
                            Type:=1)
        lConfirm = MsgBox( _
                            Prompt:="Do you wish to have a " & dbPercentIncrease & " percent price increase?", _
                            Buttons:=vbYesNoCancel, _
                            Title:="Confirm Price Increase")
        If lConfirm = vbCancel Then Exit Sub
    Loop While lConfirm = vbNo
    Do
        dbRoundupAmount = Application.InputBox( _
                          Prompt:="Please enter the round up amount for pricing under $20", _
                          Title:="Price Increase Round Up", _
                          Type:=1)
        lConfirm = MsgBox( _
                          Prompt:="Do you wish to have a $." & dbRoundupAmount & " round up amount?", _
                          Buttons:=vbYesNoCancel, _
                          Title:="Confirm Round Up Amount")
        If lConfirm = vbCancel Then Exit Sub
    Loop While lConfirm = vbNo
    
    ThisWorkbook.Activate
    For Each ws In ActiveWindow.SelectedSheets
        Set rg = ws.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
        For Each c In rg
            If c.Value2 > 0 Then
                If c.Value2 >= 20 Then
                    c.Value2 = WorksheetFunction.RoundUp(c.Value2 + c.Value2 * dbPercentIncrease, 0)
                    c.Interior.Color = vbRed
                Else
                    c.Value2 = WorksheetFunction.Ceiling(c.Value2 + c.Value2 * dbPercentIncrease, dbRoundupAmount)
                    c.Interior.Color = vbGreen
                End If
            End If
        Next c
    Next ws
End Sub

**Marvelous** · 06-15-2021, 12:49 PM

Dangelor,

Thank you for working on this! This looks promising. When running your code, I get the popup below and when hitting debug it highlights this line:

Set rg = ws.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)

. Maybe this is due to the cell format? The original price list excel files are exported from PDF files which give me several different number formats in the excel file. Thus the reason I had all of the "or" statements

Cell.NumberFormat = "\$0" Or Cell.NumberFormat = "\$#,##0" Or Cell.NumberFormat = "\$#,##0.00" Or Cell.NumberFormat = "\$0.00" Or Left(Cell.NumberFormat, 1) = "$"

in my original code. I know just enough VBA to be dangerous so please excuse me if I am not making any sense.Attachment 736649

**dangelor** · 06-15-2021, 12:54 PM

You posted an invalid attachment.

What is the exact wording of the error?

**Marvelous** · 06-15-2021, 02:04 PM

Sorry about the attachment, "Run-time error '1004': No cells were found

**Marvelous** · 06-15-2021, 04:44 PM

Hopefully this image works Message.png

**dangelor** · 06-16-2021, 11:21 AM

The file in your first post has no problem with this code. Can you post a different workbook, one that generates this error?

**Marvelous** · 06-18-2021, 09:21 AM

Hello Dangelor,

Thank you for continued assistance! The actual workbook is huge with about 165 sheets. I will try to extract a couple of sheets and see if I can get the same error as I did with the entire workbook.

Best regards

**Marvelous** · 06-20-2021, 10:30 AM

Hello dangelor,

I have attached a different workbook with three worksheets. I tried selecting one sheet and running macro then I tried selecting all three but in both instances I get: Runtime error 1004 no cells found. Also, I noticed that after entering the "Price Increase Round Up" that the confirmation window showed the roundup amount with two decimal points ($.0.05)as shown in this image.
Price Increase Round Up.png. I'm not sure if that is relevant. In all cases when I click on the debug button it highlights

Set rg = ws.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)

.

Thanks in advance!
Marvelous (not so much!)

**dangelor** · 06-21-2021, 07:40 AM

Sorry, but the file in post #9 will not load correctly on my system.

Edit: Got it to load.

**Marvelous** · 06-21-2021, 08:51 AM

dangelor,

This is bizarre. I saved the file as an xlsx file and I am able to download and open it without any problems. Do you have any idea why this would be happening? I have Microsoft 365 Apps for enterprise and am currently on Version 2104 (Build 13929.20408 Click-to-Run) Monthly Enterprise Channel. I have saved it as an xlsm file and re-attached it. Should I send it to you some other way?

I know it would be easy for you to just drop this and go to other easier posts so I appreciate that you have continued to respond!

Marvelous

**dangelor** · 06-21-2021, 08:57 AM

This seems to work on the file in Post #9

Option Explicit

Sub Test()
    Dim dbPercentIncrease As Double, dbRoundupAmount As Double
    Dim ws As Worksheet, rg As Range, c As Range
    Dim lConfirm As Long

    Do
        dbPercentIncrease = Application.InputBox( _
                            Prompt:="Please enter the percentage of the price increase", _
                            Title:="Price Increase %", _
                            Type:=1)
        lConfirm = MsgBox( _
                            Prompt:="Do you wish to have a " & dbPercentIncrease & " percent price increase?", _
                            Buttons:=vbYesNoCancel, _
                            Title:="Confirm Price Increase")
        If lConfirm = vbCancel Then Exit Sub
    Loop While lConfirm = vbNo
    Do
        dbRoundupAmount = Application.InputBox( _
                          Prompt:="Please enter the round up amount for pricing under $20", _
                          Title:="Price Increase Round Up", _
                          Type:=1)
        lConfirm = MsgBox( _
                          Prompt:="Do you wish to have a $." & dbRoundupAmount & " round up amount?", _
                          Buttons:=vbYesNoCancel, _
                          Title:="Confirm Round Up Amount")
        If lConfirm = vbCancel Then Exit Sub
    Loop While lConfirm = vbNo
    
    ThisWorkbook.Activate
    For Each ws In ActiveWindow.SelectedSheets
        On Error Resume Next
        Set rg = ws.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
        On Error GoTo 0
        If Not rg Is Nothing Then
            For Each c In rg
                If c.NumberFormat = "\$0" _
                   Or c.NumberFormat = "\$#,##0" _
                   Or c.NumberFormat = "\$#,##0.00" _
                   Or c.NumberFormat = "\$0.00" _
                   Or Left(c.NumberFormat, 1) = "$" _
                   And c.Font.Bold = True Then
                    If c.Value2 > 0 Then
                        If c.Value2 >= 20 Then
                            c.Value2 = WorksheetFunction.RoundUp(c.Value2 + c.Value2 * dbPercentIncrease, 0)
                            c.Interior.Color = vbRed
                        Else
                            c.Value2 = WorksheetFunction.Ceiling(c.Value2 + c.Value2 * dbPercentIncrease, dbRoundupAmount)
                            c.Interior.Color = vbGreen
                        End If
                    End If
                End If
            Next c
        End If
    Next ws
End Sub

**Marvelous** · 06-22-2021, 12:04 PM

dangelor,

Thank you so much! This works great!... if I insert the module in the actual workbook I am working on. I was trying to use my personal workbook because I have different workbooks I would like to use the code on and wasn't successful. There were no errors but it would just send me back to the vba module. I think it was going back to either the

ThisWorkbook.Activate

or the

For Each ws in ActiveWindow.SelectedSheets

area. Is there something I need to change to place in Personal Workbook? I will mark this thread as solved as soon as I hear from you.
Marvelous

**dangelor** · 06-22-2021, 12:22 PM

The 'Thisworkbook' refers to the workbook holding the running code, and as such, would not work on any other workbook if it was run from a Personal workbook (which actually is an open workbook with all the worksheets hidden). To make it compatible with an 'unknown to the code' open workbook, use either Activeworkbook or better, assign a variable to the active workbook, i.e., set wb = Activeworkbook.

**Marvelous** · 06-23-2021, 08:53 AM

dangelor,

Excellent explanation! Not only have you helped me with my project but this helps me understand the code. Best wishes
Marvelous

**dangelor** · 06-23-2021, 08:56 AM

Good luck!

For each loop applying to all values instead of > $20.00

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

For each loop applying to all values instead of > $20.00

Re: For each loop applying to all values instead of > $20.00

Re: For each loop applying to all values instead of > $20.00

Re: For each loop applying to all values instead of > $20.00

Re: For each loop applying to all values instead of > $20.00

Re: For each loop applying to all values instead of > $20.00

Re: For each loop applying to all values instead of > $20.00

Re: For each loop applying to all values instead of > $20.00

Re: For each loop applying to all values instead of > $20.00

Re: For each loop applying to all values instead of > $20.00

Re: For each loop applying to all values instead of > $20.00

Re: For each loop applying to all values instead of > $20.00

Re: For each loop applying to all values instead of > $20.00

Re: For each loop applying to all values instead of > $20.00

Re: For each loop applying to all values instead of > $20.00

Re: For each loop applying to all values instead of > $20.00

Thread Information

Users Browsing this Thread

Similar Threads

Applying Formula to assign numeric values to text values in sequential order

Loop through range, applying bold formatting to chara before first line break in each cell

Applying Same Formula To Cells With Different Values

[SOLVED] Loop through workbook applying two different actions to two sets of sheets

Automation: applying conditional formatting to group of cells in a loop

Applying a formula with a for loop

VBA Question - Applying values

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions