Function to encapsulate code block into a constant?

P

(PeteCresswell)

I writing more and more apps where the application generates an
Excel spreadsheet and pushes various VBA routines into it.

I seem to be spending too many man hours on the details
(placement of vblf's, "_", quotes, and such when creating
constants.

I'm thinking I should be able to develop the routine in an Excel
spreadsheet, test it... and then feed the routine to a function
that returns a monster constant like the one below - even
checking for excessive continuations and breaking it up into
multiple constants as needed.



For example, this:
-----------------------------------------------------------
Const myCode1 As String = _
"Private Sub TrancheData_Retrieve(ByVal theLookupKey as
string, byVal theColNum_Key as long, ByVal theTableRow_First As
Long, byVal theTableRow_Last as long, byval theNumberOfFields as
Long, byRef theTargetRange As Range)" & vbLf & _
" Dim tableRange as Range" & vbLf & _
" Dim sourceRange as Range" & vbLf & _
" Dim myResult As Double" & vbLf

Const myCode2 As String = _
" " & vbLf & _
" With Worksheets(""TrancheData"")" & vbLf & _
" Set tableRange = .Range(.Cells(theTableRow_First,
theColNum_Key), .Cells(theTableRow_Last, theColNum_Key))" & vbLf
& _
" End With" & vbLf & _
" " & vbLf & _
" myResult =
Application.WorksheetFunction.Match(theLookupKey, tableRange, 0
)" & vbLf & _
" " & vbLf & _
" If Not IsError(myResult) Then" & vbLf & _
" Set sourceRange = tableRange(myResult)" & vbLf & _
" Set sourceRange = sourceRange.Offset(0, 3)" & vbLf &
_
" Set sourceRange = sourceRange.Resize(1,
theNumberOfFields)" & vbLf & _
" sourceRange.Copy theTargetRange" & vbLf & vbLf & _
" 'MsgBox "" Key='"" & theLookupKey & ""'"" & vbLf
& _" & vbLf & _
" ' ""Relative='"" & myResult & ""'"" & vbLf
& _" & vbLf & _
" ' ""Absolute='"" & myResult +
theTableRow_First - 1 & ""'"" & vbLf & _ " & vbLf & _
" ' "" Address='"" & sourceRange.Address &
""'."", vbInformation, ""And The Lookup Key Is.. """ & vbLf & _
" End If" & vbLf & _
" " & vbLf & _
" Set tableRange = Nothing" & vbLf & _
" Set sourceRange = Nothing" & vbLf & _
" " & vbLf & _
"End Sub"
-----------------------------------------------------------


.... creates a VBA routine in a spreadsheet that looks like
this:
-----------------------------------------------------------
Private Sub TrancheData_Retrieve(ByVal theLookupKey As String,
ByVal theColNum_Key As Long, ByVal theTableRow_First As Long,
ByVal theTableRow_Last As Long, ByVal theNumberOfFields As Long,
ByRef theTargetRange As Range)
Dim tableRange As Range
Dim sourceRange As Range
Dim myResult As Double

With Worksheets("TrancheData")
Set tableRange = .Range(.Cells(theTableRow_First,
theColNum_Key), .Cells(theTableRow_Last, theColNum_Key))
End With

myResult = Application.WorksheetFunction.Match(theLookupKey,
tableRange, 0)

If Not IsError(myResult) Then
Set sourceRange = tableRange(myResult)
Set sourceRange = sourceRange.Offset(0, 3)
Set sourceRange = sourceRange.Resize(1, theNumberOfFields)
sourceRange.Copy theTargetRange

'MsgBox " Key='" & theLookupKey & "'" & vbLf & _
' "Relative='" & myResult & "'" & vbLf & _
' "Absolute='" & myResult + theTableRow_First - 1 & "'"
& vbLf & _
' " Address='" & sourceRange.Address & "'.",
vbInformation, "And The Lookup Key Is.. "
End If

Set tableRange = Nothing
Set sourceRange = Nothing
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top