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
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