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

[SteveOranjin]

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)

MSRP	MAP
A2	b2
2.00	=A2*.75

<tbody>
</tbody>

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

 

[SteveOranjin]

It seems I forgot to post my 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

 

[Yongle]

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

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

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

 

[Yongle]

To format the cell to 2 places of decimal
Insert

rng.Offset(, 1).NumberFormat = "0.00"

Below

Set rng = Range(rngMSRPHeader.Offset(1), lastCell)

 

[SteveOranjin]

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?

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

 

[SteveOranjin]

OH wait, I got it. Nvm. If you pretended I never posted this that would be ok.