VBA for different formulas to reduce the excel file

[MMM_84]

Hello excel gurus, looking for a help to write a proper vba that runs formulas in different columns of spreadsheet anytime the concerned cell is triggered from row 2 down to the last row, since I will be removing, adding new rows.

So, if I enter value in T2, I want U2 to show the value derived from formula ‘=vlookup(T2, Sheet2!A:C,2)’. Once U2 has a value I want V2 to show calculation of ‘U2*10’. Then, once I enter value into W2, I want X2 to show the value derived from formula ‘=index match…’. Once X2 has a value I want Y2 to show calculation of ‘X2*10’.

And repeat this to the last row anytime I enter new row and new values into corresponding row and column.

Please see example, where yellow formulas to be hidden in VBA and run only when corresponding is triggered. Hope I'm clear enough Thanks for any advice

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA
1	Name	Last name	address	code	function	position	role	grade	other info 1	other info 2	other info 3	other info 4	other info 5	other info 6	other info 7	other info 8	other info 9	other info 10	other info 11	Manual value to be entered	bring me approx value	calculate	Manual value to be entered	bring me approx value	calculate	Manual value to be entered	calculate
2	John	Paul	home address	1111	Sales & marketing	sales	specialist	44												5000	=vlookup(T2, Sheet2!A:C,2)'	=U2*10'	1000	=INDEX(Sheet2!G:G,MATCH(1,(W2>=Sheet8!E:E)*(W2<=Sheet2!F:F),0))	=X2*7'	800	=Z2*3'
3
4
5
6
7
8
Sheet1

 

[Kaper]

Leave row 2 with formulas. Copy and paste all data below as values
Paste such code in your sheet module (so right-click on tab with sheet name and select View Code, then paste the code from forum), close VBA editor, save as macro-enabled format (like xlsm) and test writing in columns T or W in empty row.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cell As Range
Set rng = Intersect(Target, Range("T3:T" & Rows.Count))
  If Not rng Is Nothing Then
    For Each cell In rng
      Application.EnableEvents = False
      With cell.Offset(0, 1)
        .FormulaR1C1 = Range("U2").FormulaR1C1
        .Calculate
        .Value = .Value
      End With
      Application.EnableEvents = True
    Next cell
  End If
Set rng = Intersect(Target, Range("W3:W" & Rows.Count))
  If Not rng Is Nothing Then
    For Each cell In rng
      Application.EnableEvents = False
      With cell.Offset(0, 1)
        .FormulaR1C1 = Range("X2").FormulaR1C1
        .Calculate
        .Value = .Value
      End With
      Application.EnableEvents = True
    Next cell
  End If
End Sub

If there would be more than 2 such columns, you may consider making a whole action in a loop going through columns.

If you don't want to leave formulas in row 2 you can write formular1c1 for a source cell directly into a code.


so for the column T it could be:

        .FormulaR1C1 = "=VLOOKUP(RC[-1],Sheet2!C[-20]:C[-18],2)"

and for column W

        .FormulaR1C1 = "=INDEX(Sheet2!C[-17],MATCH(1,(RC[-1]>=Sheet8!C[-19])*(RC[-1]<=Sheet2!C[-18]),0))"

and ranges could start with row 2, like:

Set rng = Intersect(Target, Range("T[B]2[/B]

etc.

 

[myall_blues]

Another option. Needs error checking added in case contents of a target cell are deleted.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("T:T, W:W, Z:Z")) Is Nothing Or Target.Row = 1 Then Exit Sub
    Application.EnableEvents = False
    Select Case Target.Column
        Case Is = 20
            Cells(Target.Row, Target.Column + 1).Value = Evaluate("=vlookup(" & Target.Address & ", Sheet2!A:C,2)")
            Cells(Target.Row, Target.Column + 2).Value = Evaluate("=offset(" & Target.Address & ",0,1)*10")
        Case Is = 23
            Cells(Target.Row, Target.Column + 1).Value = _
                Evaluate("=INDEX(Sheet1!G:G,MATCH(1,(" & Target.Address & ">=Sheet8!E:E)*(" & Target.Address & "<=Sheet1!F:F),0))")
            Cells(Target.Row, Target.Column + 2).Value = Evaluate("=offset(" & Target.Address & ",0,1)*7")
        Case Is = 26
            Cells(Target.Row, Target.Column + 1).Value = Evaluate("=" & Target.Address & "*3")
        Case Else
            MsgBox "Error!"
    End Select
    Application.EnableEvents = True
End Sub

This code needs to go in the Worksheet_Change event of your worksheet. To do that open the VBA editor (ALT+F11) and on the left hand side right-click on the sheet you're working in and click View Code. Then paste the code in the window that appears.

 

[MMM_84]

Another option. Needs error checking added in case contents of a target cell are deleted.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("T:T, W:W, Z:Z")) Is Nothing Or Target.Row = 1 Then Exit Sub
    Application.EnableEvents = False
    Select Case Target.Column
        Case Is = 20
            Cells(Target.Row, Target.Column + 1).Value = Evaluate("=vlookup(" & Target.Address & ", Sheet2!A:C,2)")
            Cells(Target.Row, Target.Column + 2).Value = Evaluate("=offset(" & Target.Address & ",0,1)*10")
        Case Is = 23
            Cells(Target.Row, Target.Column + 1).Value = _
                Evaluate("=INDEX(Sheet1!G:G,MATCH(1,(" & Target.Address & ">=Sheet8!E:E)*(" & Target.Address & "<=Sheet1!F:F),0))")
            Cells(Target.Row, Target.Column + 2).Value = Evaluate("=offset(" & Target.Address & ",0,1)*7")
        Case Is = 26
            Cells(Target.Row, Target.Column + 1).Value = Evaluate("=" & Target.Address & "*3")
        Case Else
            MsgBox "Error!"
    End Select
    Application.EnableEvents = True
End Sub

This code needs to go in the Worksheet_Change event of your worksheet. To do that open the VBA editor (ALT+F11) and on the left hand side right-click on the sheet you're working in and click View Code. Then paste the code in the window that appears.

Thanks! smth is wrong as I get #REF! instead of values in cells with vlookup and index match formulas

 

[MMM_84]

Another option. Needs error checking added in case contents of a target cell are deleted.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("T:T, W:W, Z:Z")) Is Nothing Or Target.Row = 1 Then Exit Sub
    Application.EnableEvents = False
    Select Case Target.Column
        Case Is = 20
            Cells(Target.Row, Target.Column + 1).Value = Evaluate("=vlookup(" & Target.Address & ", Sheet2!A:C,2)")
            Cells(Target.Row, Target.Column + 2).Value = Evaluate("=offset(" & Target.Address & ",0,1)*10")
        Case Is = 23
            Cells(Target.Row, Target.Column + 1).Value = _
                Evaluate("=INDEX(Sheet1!G:G,MATCH(1,(" & Target.Address & ">=Sheet8!E:E)*(" & Target.Address & "<=Sheet1!F:F),0))")
            Cells(Target.Row, Target.Column + 2).Value = Evaluate("=offset(" & Target.Address & ",0,1)*7")
        Case Is = 26
            Cells(Target.Row, Target.Column + 1).Value = Evaluate("=" & Target.Address & "*3")
        Case Else
            MsgBox "Error!"
    End Select
    Application.EnableEvents = True
End Sub

This code needs to go in the Worksheet_Change event of your worksheet. To do that open the VBA editor (ALT+F11) and on the left hand side right-click on the sheet you're working in and click View Code. Then paste the code in the window that appears.

Thanks! All works I figured