HiveBrain v1.2.0
Get Started
← Back to all entries
snippetMinor

Capture worksheet formulas in VBA format

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
formatcaptureformulasworksheetvba

Problem

I had been searching for a simple way to capture worksheet formulas in VBA format. I came up with a solution below, which I wanted to share.

With any luck this could be useful to someone down the road. Suggestions for improvement are welcome.

```
Public Const vbQuadrupleQuote As String = """""" 'represents 2 double quotes for use in VBA R1C1 formulas ("")
Public Const vbDoubleQuote As String = """" 'represents 1 double quote (")
Public Const vbSingleQuote As String = "'" 'represents 1 single quote (')

Sub CaptureFormulas() 'simplifies the capturing of worksheet formulas in VBA format

'Peter Domanico, May 2017

'Steps:

'(1) place this script in your personal macro workbook
'(2) open Immediate Window in VBA (Control + G)
'(3) run this script and follow prompts
'(4) a With statement containing formulas for your selection will be printed to the Immediate Window
'(5) you can use this With statement in any script

Dim ws As String
Dim rng As Range
Dim MyString As String
Dim MyColumn As Variant
Dim MyRow As Variant
Dim LastRow As String
Dim MyRange As String
Dim MyFormula As String

'set worksheet string
ws = "Activesheet" 'change this as needed

'error handling
On Error GoTo OuttaHere

'select range
Set rng = Application.InputBox("Select range to capture", ": )", Type:=8)

'determine formula type
MyQuestion = MsgBox(Prompt:="Fill formulas to last row?", _
Buttons:=vbYesNo, Title:="???")

Debug.Print "Dim ws as Worksheet" 'change this as needed
Debug.Print "Set ws = Activesheet" 'change this as needed
Debug.Print "LastRow = ws.Cells(Rows.Count,1).End(xlUp).Row" 'change this as needed
Debug.Print "With ws" 'change this as needed

For Each rng In rng
MyColumn = rng.Column
CurrentRow = rng.Row
Select Case MyQuestion
Case vbYes
LastRow = "LastRow"
Case vbNo
LastRow = CurrentRow
End Select
MyRange = ".Range(.Cells(" & CurrentRow & "," & MyColumn & "),.Cells(" & LastRow & "," & MyColumn & "))="
MyF

Solution

First design problem is that you're outputting to the immediate pane, which isn't meant to hold data like this - it will only ever display up to 255 lines, which means as soon as your range has more than 250-some rows, your code stops being useful.

First code problem is that Option Explicit is missing, and you have undeclared variables:

  • MyQuestion (which is really an answer, since it's a vbMsgBoxResult) isn't declared.



  • CurrentRow isn't declared.



Then you have declared variables that aren't used anywhere:

  • MyRow isn't used.



You're not validating rng, so if the InputBox gets cancelled, you get a run-time error 424 "Object Required" and jump OuttaHere - which isn't too bad, except for the fact that getting valid user input is a concern in its own right, and really belongs in its own dedicated function.

Set rng = SelectRangeToCapture
    If rng Is Nothing Then Exit Sub


'@Description "Prompts for a Range. Returns Nothing if no selection is made."
Private Function SelectRangeToCapture() As Range
    On Error Resume Next
    Set SelectRangeToCapture = Application.InputBox("Select range to capture", ": )", Type:=8)
    Err.Clear
    On Error GoTo 0
End Function


It doesn't feel right that you need to check MyQuestion for every single iteration of that loop - the value is the same every time, you're wasting cycles here. MyQuestion should be named fillToLastRow and be a Boolean:

fillToLastRow = MsgBox(...) = vbYes


And then the LastRow assignment can be a simple IIf function result:

LastRow = IIf(fillToLastRow, "LastRow", CStr(currentRow))


Note the explicit type conversion for currentRow, from Long to String.

The generated code needs to be indented and properly spaced. Lack of whitespace between operators and operands can easily turn into compile errors, because of how VBA interprets type hints - not necessarily here in this code, but lack of whitespace turning & concatenation operator into a & type hint on a variable or literal value is a quite recurrent, easily avoided question on Stack Overflow.

The LastRow logic assumes column A contains data: the reference column should be based on rng instead.

I'm also a bit puzzled about why you would want to use R1C1 notation in the formulas, but maybe it's just because I never needed to use it in 15 years.

Why not go all the way, reference the VBIDE type library and actually output your generated code to an actual procedure, in an actual module? That way you wouldn't be limited to 255 lines. Although.. I wonder if that's a good idea, given VBA won't even compile a procedure that's more than 10,000 lines, or a module with more than 65,535 lines - in other words, rng.Count needs to be capped and validated, otherwise you either lose data, or generate code that can't even compile.

In general I don't like VBA code that requires frequent modifications. Code should be written to resist change - yours embraces change with arms wide open, pretty much as part of its own specification, including instructions-in-comments.

Speaking of comments... Comments should say why, not what. These comments say nothing that the code doesn't already say:

'error handling
On Error GoTo OuttaHere


'select range
Set rng = Application.InputBox("Select range to capture", ": )", Type:=8)


'set worksheet string
ws = "Activesheet"


One last note about naming: OuttaHere isn't normally a label you'd find in professionally-written code. CleanExit would be more appropriate. MyXxxxx identifiers are annoying, too: such names don't convey much information, other than a vague data type that belongs to something (or someone?). Take the time to name things, meaningfully.

  • MyRange holds an assignment instruction, not a Range.



  • MyFormula holds the Excel formula in the current cell.



  • MyString holds a VBA instruction.



And so on.

Code Snippets

Set rng = SelectRangeToCapture
    If rng Is Nothing Then Exit Sub
'@Description "Prompts for a Range. Returns Nothing if no selection is made."
Private Function SelectRangeToCapture() As Range
    On Error Resume Next
    Set SelectRangeToCapture = Application.InputBox("Select range to capture", ": )", Type:=8)
    Err.Clear
    On Error GoTo 0
End Function
fillToLastRow = MsgBox(...) = vbYes
LastRow = IIf(fillToLastRow, "LastRow", CStr(currentRow))
'error handling
On Error GoTo OuttaHere

Context

StackExchange Code Review Q#163463, answer score: 3

Revisions (0)

No revisions yet.