Front-End Formulas to VBA Functions

[lneidorf]

Hi there.

I've been dabbling with VBA for years now, though my code is little more than cobbled-together mishmash. As my scenarios get more complex, I'm increasingly aware of my need to step things up.

My code is inefficient and, all too frequently, relies upon my front-end knowledge of complex formulas. Which is to say, I frequently use VBA to poulate cells with built-in formulas and copy them down along a range. I know this is terribly inefficient.

Here's some sample code from a recent project, in which I populate cells with three different formulas and then fill them down:

    Range("L2").Select
    Range("L2").Value = "=COUNTIF(H:H,H2)"
    'Dim lastRow As Long
    lastRow = Columns(1).Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    ActiveCell.AutoFill Destination:=Range(ActiveCell, Cells(lastRow, ActiveCell.Column))
    Range("L2", Selection.End(xlDown)).Value = Range("L2", Selection.End(xlDown)).Value
    
    Range("M2").Select
    Range("M2").Value = "=IF(ISNUMBER(SEARCH(""\\ln"",G2)),(MID((G2&""\""),FIND(CHAR(135),SUBSTITUTE((G2&""\""),""\"",CHAR(135),5))+1,10000)),(SUBSTITUTE(G2,""\"",,1)))"
    lastRow = Columns(1).Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    ActiveCell.AutoFill Destination:=Range(ActiveCell, Cells(lastRow, ActiveCell.Column))
    Range("M2", Selection.End(xlDown)).Value = Range("M2", Selection.End(xlDown)).Value
    
    Range("N2").Select
    Range("N2").Value = "=M2&I2&""\""&F2&""\""&B2"
    lastRow = Columns(1).Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    ActiveCell.AutoFill Destination:=Range(ActiveCell, Cells(lastRow, ActiveCell.Column))
    Range("N2", Selection.End(xlDown)).Value = Range("N2", Selection.End(xlDown)).Value

The first and third formula are rather simple, the second one a little more complex.


I need to abandon this approach and learn how to convert front-end formulas into VBA functions. Since most of what I've learned is by studying the code of others, I figured I'd post this and see if anyone can demonstrate how to accomplish any of these three samples with a purely-VBA approach.

Thanks as always!

 

[dave3009]

Hi

You could simplify the code like so

Sub doFormulas()
    Range("L2").Formula = "=COUNTIF(H:H,H2)"
    Range("M2").Formula = "=IF(ISNUMBER(SEARCH(""\\ln"",G2)),(MID((G2&""\""),FIND(CHAR(135),SUBSTITUTE((G2&""\""),""\"",CHAR(135),5))+1,10000)),(SUBSTITUTE(G2,""\"",,1)))"
    Range("N2").Formula = "=M2&I2&""\""&F2&""\""&B2"
    'Dim lastRow As Long
    lastrow = Range("A" & Rows.Count).End(xlUp).Row
    Range("L2:N2").Copy Range("L2:N" & lastrow)
End Sub

So just enter the formulas first and copy down all in the one go.

Is this the solution you were looking for?

Regards

Dave

 

[lneidorf]

Thanks for your response, Dave.

What I'm looking to do is to stop using Excel formulas and adopt a purely VBA-driven approach. Populating cells with formulas and filling them down is incredibly inefficient and resource-intensive. So I want to instead use VBA functions and loop them through a range.

 

[Michael M]

I'd have to disagree

Populating cells with formulas and filling them down is incredibly inefficient and resource-intensive.

I would have thought that using native Excel functions would be more efficient than trying to create VBA methods
The code provided by Dave would fill all required cells with formulae almost instantly.
you could also use

Sub doFormulas()
    Dim lastRow As Long
    lastrow = Range("A" & Rows.Count).End(xlUp).Row   
    Range("L2: L" & lastrow).Formula = "=COUNTIF(H:H,H2)"
    Range("M2:M" & lastrow).Formula = "=IF(ISNUMBER(SEARCH(""\\ln"",G2)),(MID((G2&""\""),FIND(CHAR(135),SUBSTITUTE((G2&""\""),""\"",CHAR(135),5))+1,10000)),(SUBSTITUTE(G2,""\"",,1)))"
    Range("N2:N" & lastrow).Formula = "=M2&I2&""\""&F2&""\""&B2"
End Sub

 

[lneidorf]

Thanks Michael.

I guess my real concern is around VLOOKUPs. Those are the parts of my code that take a very long time to execute and sometimes error out. Here's a portion of my code that performs a lookup, fills down, overwrites the results with values, and then fills in the blanks in the range with the values from the nearest populated row above:

    Sheets("Primary - ALL").Select
    
    'Family Sort (Attachment Family ID = A to Z; Document Type = Z to A)
    Range("A:M").Sort Key1:=Range("C:C"), Order1:=xlAscending, Key2:=Range("D:D"), Order2:=xlDescending, Header:=xlYes, Orientation:=xlSortColumns

    Range("L2").Select
    Range("L2").Value = "=IFERROR(VLOOKUP(A2,'Primary Parents + Dupes'!A:O,15,0),"""")"
    lastRow = Columns(1).Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    ActiveCell.AutoFill Destination:=Range(ActiveCell, Cells(lastRow, ActiveCell.Column))
    Range("L:L").Value = Range("L:L").Value
    
    'Fill blank cells with values from above
    'Range("L2:L6462").Select
    Range("A2", Range("A1").End(xlDown)).Offset(, 11).Select
    'LastRowInColL

Application.Wait (Now + TimeValue("0:00:10"))

    'Range("L2:L" & ActiveSheet.UsedRange.Rows.Count).Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
    Range("L:L").Value = Range("L:L").Value

I've had trouble getting this to execute and ended up inserting a pause (Application.Wait) of 10 seconds, which seems to work at the moment. But it still errors out every now and then, I assume due to a shortage of available system resources.

Am I mistaken that this approach, with a lookup formula, is inefficient? Wouldn't some sort of VBA Loop routine be a better approach? My hope is to optimize my code and roll this out so that others (with more modest computer setups than mine) to use this on their machines.

Thanks!

 

[Michael M]

A couple of things
Try to avoid Selecting anything, it's inefficient and unnecessary
AND
Avoid referencing entire columns....find the last row and reference to there.
Maybe like this.....UNTESTED

Sub MM1()
Dim lr As Long
Application.ScreenUpdating = False
lr = Sheets("Primary - ALL").Cells(Rows.Count, "A").End(xlUp).Row
With Sheets("Primary - ALL")
    'Family Sort (Attachment Family ID = A to Z; Document Type = Z to A)
    .Range("A1:M" & lr).Sort Key1:=Range("C1:C" & lr), Order1:=xlAscending, Key2:=Range("D1:D" & lr), Order2:=xlDescending, Header:=xlYes, Orientation:=xlSortColumns

    .Range("L2:L" & lr).Formula = "=IFERROR(VLOOKUP(A2,'Primary Parents + Dupes'!A:O,15,0),"""")"
    .Range("L2:L" & lr).Value = .Range("L2:L" & lr).Value
    
    'Fill blank cells with values from above
    'Range("L2:L6462").Select
    'LastRowInColL
End With

    'Range("L2:L" & ActiveSheet.UsedRange.Rows.Count).Select
    Range("L2:L" & lr).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    Range("L2:L" & lr).Value = Range("L2:L" & lr).Value
Application.ScreenUpdating = True
End Sub