0

I am working on a macro that was previously written by an old employee. I am a new VBA user so I am not versed on how to properly do this.

I need the formula to not apply to rows where "IBK" is present. Right now it is applying to every row.

I have tried to actually just re-write and filter the different criteria and apply the formula that way, however, the macro wouldn't work

this is the formula

Columns("Q:Q").Select
Selection.Clear
Range("Q1").Select
ActiveCell.FormulaR1C1 = "New Savings"
Range("Q2").Select
ActiveCell.Formula = "=P2-(7/D2)"
Selection.AutoFill Destination:=Range("Q2:Q" & Range("A" & 
Rows.Count).End(xlUp).Row)
Range("Q2")

Picture attached is the sample data. I obviously work with far more data than this. I need the formula to know not to subtract 7 from the IBK through the macro. So the IBK’s would total 50 instead of 43.

Picture : https://i.stack.imgur.com/sBHul.png

Ricardo Diaz
  • 5,658
  • 2
  • 19
  • 30

2 Answers2

0

Read the comments and adjust the parameters

Sub ApplyFormula()

    Dim evalSheet As Worksheet
    Dim formulaRange As Range

    Dim worksheetName As String
    Dim colEval As String
    Dim colFormula As String
    Dim formulaText As String
    Dim colNumber As Integer
    Dim firstRow As Byte
    Dim lastRow As Long

    ' 1) Set some parameters

        ' Define name of sheet where formulas are going to be added
        worksheetName = "sheet1"
        Set evalSheet = ThisWorkbook.Worksheets(worksheetName)
        'Set evalSheet = Sheet1 ' -> This could come from VBA Editor and replace the previous two lines. It's safer if you use the sheet vba codename see https://stackoverflow.com/questions/41477794/refer-to-sheet-using-codename

        ' Define the column letter where Managed Type is localted
        colEval = "A"
        ' Define the column letter where Formulas should be added (New savings)
        colFormula = "D"
        ' Define where evaluated range begins
        firstRow = 2
        ' Define formula text. text between [] will be replaced
        formulaText = "=IF([colEval][firstRow] = 'IBK', P[firstRow], P[firstRow] - (7 / D[firstRow]))"


    ' 2) Adjust stuff and add the formulas

        ' Adjust the formula to replace the single quotes with doubles
        formulaText = Replace(formulaText, "'", """")
        formulaText = Replace(formulaText, "[colEval]", colEval)
        formulaText = Replace(formulaText, "[firstRow]", firstRow)

        ' Get the column number from the column letter
        colNumber = Columns(colEval).Column

        ' Get the last row with data in column evaluated
        lastRow = evalSheet.Cells(evalSheet.Rows.Count, colNumber).End(xlUp).Row

        ' Set the range to be evaluated
        Set formulaRange = evalSheet.Range(colFormula & firstRow & ":" & colFormula & lastRow)

        ' Add the formulas
        formulaRange.Formula = formulaText

End Sub
Ricardo Diaz
  • 5,658
  • 2
  • 19
  • 30
-1

Make the following changes

'add 4 lines
Dim colIBK As String, newFormula As String
On Error Resume Next
colIBK = Split(Cells(1, Application.Match("Managed Type", Range("A1:BB1"), 0)).Address(True, False), "$")(0)
On Error GoTo 0

Columns("Q:Q").Select
Selection.Clear
Range("Q1").Select
ActiveCell.FormulaR1C1 = "New Savings"
Range("Q2").Select

'add 1 line and change the next
newFormula = "=if(" & colIBK & "2 = ""IBK"","""",P2-(7/D2))"
ActiveCell.Formula = newFormula

Selection.AutoFill Destination:=Range("Q2:Q" & Range("A" & Rows.Count).End(xlUp).Row)
Range("Q2").Select

After getting colIBK, you might test for "" and bail out with error message if the column is not found.

newFormula could also be just P2 "=if(" & colIBK & "2 = ""IBK"",P2,P2-(7/D2))"

donPablo
  • 1,937
  • 1
  • 13
  • 18
  • I need the IBKs value in the savings column to still come over. The formula will justshow a blank. If I remove the ,””””, and replace it with columns will that work? –  Oct 12 '19 at 02:18
  • Be adventuresome. See my note 'could also be...' just about anything. Try it. If you like it and it solves it, click on the check mark by the solution. Add lines like colSavings and colXXX in case columns "P" and "D" and "?" move around on the spreadsheet. – donPablo Oct 12 '19 at 03:39