VBA: Insert Value As Multiplier For the Cell Next To It

SteveOranjin

Board Regular
Joined
Dec 18, 2017
Messages
170
Hello,

Hope you are well. I'm getting ok at this VBA stuff. But not that good.

So I have some code here that is designed to insert column next to a column that will always have the header, "MSRP".

If it returns finds a column with the header, "MSRP", what I want it to do is return the MAP policy do the user, and then allow the user to enter the MAP policy into a text entry field in a msg box. I want it to then populate all of the cells down to the last populated cell in the row.

Right now, all it does is it inserts the new column, and allows the user to insert the map policy.

The multiplier will usually be a decimal. Usually the way the multiplier is applied is (look below)



[TABLE="width: 500"]
<tbody>[TR]
[TD]MSRP

[/TD]
[TD]MAP[/TD]
[/TR]
[TR]
[TD]A2[/TD]
[TD]b2[/TD]
[/TR]
[TR]
[TD]2.00[/TD]
[TD]=A2*.75[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


The way the pop up usually appears to the user, is something like this. Please see the image.

So if the map policy is 10 percent, then the user will enter .90 into the formula. It would be great if there were a way that into the text entry box, if we could have it so the user would enter .10 into the entry box if the map policy were .10. and it would multiply by .90. But that is not necessary if that is too much.

Hope you are well

http://www.mediafire.com/view/kfe5a4e07kcrk58/fdfdfdfdfdfdfdfdfdfdfdfdfd.png
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
It seems I forgot to post my code

Rich (BB code):
Sub Insert_Map()
    'We are inserting our variables
    Dim rngMSRPHeader As Range
    Dim rngHeaders As Range
    Dim brand As String
    Dim mapPolicy As String
    
    
    Set rngHeaders = Worksheets("Data Sheet").Range("1:1") 'look in entire first row
    Set rngMSRPHeader = rngHeaders.Find(what:="MSRP", After:=Cells(1, 1))
    
    rngMSRPHeader.Offset(0, 1).EntireColumn.Insert
    rngMSRPHeader.Offset(0, 1).Value = "MAPprice"
    
    brand = Worksheets("Import Info").Cells("A2")
    mapPolicy = Worksheets("Import Info").Cells("J2")

    MsgBox ("For Brand:" & brand & vbNewLine & "The Map Policy Is" & mapPolicy)
    
End Sub
 
Upvote 0
Hi
Try this
- note the 2 errors I found in your code either cells(2,1) or Range("A2") not cells("A2")
- you should delete one of the blue options
- you may want to refine this test
Code:
If mp > 1 Then Exit Sub

the user would enter .10 into the entry box if the map policy were .10. and it would multiply by .90
Done - enter value as a decimal

Code:
Sub InsertPercent()
'your original code
    Dim rngMSRPHeader As Range, rngHeaders As Range
    Dim brand As String, mapPolicy As String

    Set rngHeaders = Worksheets("Data Sheet").Range("1:1") 'look in entire first row
    Set rngMSRPHeader = rngHeaders.Find(what:="MSRP", After:=Cells(1, 1))
    
    rngMSRPHeader.Offset(0, 1).EntireColumn.Insert
    rngMSRPHeader.Offset(0, 1).Value = "MAPprice"
    
    brand = Worksheets("Import Info").[COLOR=#b22222]Range("A2")[/COLOR]
    mapPolicy = Worksheets("Import Info").[COLOR=#b22222]Range("J2")[/COLOR]
    
    MsgBox ("For Brand:" & brand & vbNewLine & "The Map Policy Is" & mapPolicy)

'added code
    Dim mp As Variant, factor As Double, aFormula As String
    Dim cel As Range, rng As Range, lastCell As Range

    mp = InputBox("Enter Map Policy", "User input")
    If mp > 1 Then Exit Sub
    factor = 1 - mp

    With rngMSRPHeader.Parent
        If Not rngMSRPHeader Is Nothing Then
            Set lastCell = .Cells(Rows.Count, rngMSRPHeader.Column).End(xlUp)
            Set rng = Range(rngMSRPHeader.Offset(1), lastCell)
                For Each cel In rng
                    With cel.Offset(, 1)
                        [COLOR=#4b0082]'for formula in cel[/COLOR]
                        [COLOR=#000080]aFormula = "=" & cel.Address(0, 0) & "*" & factor
                        cel.Offset(, 1).Formula = aFormula[/COLOR]
                    
                        [COLOR=#4b0082]'OR value in cel[/COLOR]
                        [COLOR=#000080]cel.Offset(, 1).Value = cel.Value * factor[/COLOR]
                    End With
                Next cel          
        End If
    End With
End Sub
 
Last edited:
Upvote 0
To format the cell to 2 places of decimal
Insert
Code:
rng.Offset(, 1).NumberFormat = "0.00"
Below
Code:
Set rng = Range(rngMSRPHeader.Offset(1), lastCell)
 
Upvote 0
Why is it that when I enter, "0" into the msg box, it multiplies it by 1, but when I enter "1", it multiplies it by 0?

Code:
Sub Enter_MAP_2()
'your original code
    Dim rngMSRPHeader As Range, rngHeaders As Range
    Dim brand As String, mapPolicy As String


    Set rngHeaders = Worksheets("Data Sheet").Range("1:1") 'look in entire first row
    Set rngMSRPHeader = rngHeaders.Find(what:="MSRP", After:=Cells(1, 1))
    
    rngMSRPHeader.Offset(0, 1).EntireColumn.Insert
    rngMSRPHeader.Offset(0, 1).Value = "MAPprice"
    
    brand = Worksheets("Import Info").Range("A2")
    mapPolicy = Worksheets("Import Info").Range("J2")
    
    MsgBox ("For Brand:" & brand & vbNewLine & "The Map Policy Is" & mapPolicy)


'added code
    Dim mp As Variant, factor As Double, aFormula As String
    Dim cel As Range, rng As Range, lastCell As Range


    mp = InputBox("Enter Map Policy", "User input")
    If mp > 1 Then Exit Sub
    factor = 1 - mp


    With rngMSRPHeader.Parent
        If Not rngMSRPHeader Is Nothing Then
            Set lastCell = .Cells(Rows.Count, rngMSRPHeader.Column).End(xlUp)
            Set rng = Range(rngMSRPHeader.Offset(1), lastCell)
                For Each cel In rng
                    With cel.Offset(, 1)
                        'for formula in cel
                        'aFormula = "=" & cel.Address(0, 0) & "*" & factor
                        'cel.Offset(, 1).Formula = aFormula
                    
                        'OR value in cel
                        cel.Offset(, 1).Value = cel.Value * factor
                    End With
                Next cel
        End If
    End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,896
Messages
6,175,263
Members
452,627
Latest member
KitkatToby

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top