Having trouble with the Replace Method

[Gruuuu]

A while ago I was working on a way to parse a string as a formula, then calculate the answer. Well I'm still working on that, and I finally got it working.

Here was my original thread

http://tek-tips.com/viewthread.cfm?qid=1608956&page=3

My first thought was that I would take the string, and recursively solve the components while observing the order of operations.

I then realized that, duh, excel can do this for me.

Here's my updated code:

Function fillquery(ByVal queryfile As String)

Dim fs, ts As Object
Dim strQry, strQryLine As String
Dim strCalc, strListVar As String
Dim iCalcStart As Integer
Dim iListStart As Integer
Dim EndOfLine As Boolean

'Debug.Assert 0
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile("X:\Group\Information Technology\Information Services\Report Production\Data\AutoQuery\" & queryfile, 1)

While ts.AtEndOFStream <> True
    strQryLine = ts.ReadLine
    EndOfLine = False
    While EndOfLine <> True
    
        'Check for calculated lines. Calculate lines if found
        iCalcStart = InStr(strQryLine, "@")
        If iCalcStart Then
            strCalc = Mid(strQryLine, iCalcStart, InStr(iCalcStart + 1, strQryLine, "@") - iCalcStart + 1)
            strQryLine = Replace(strQryLine, strCalc, calculateString(strCalc), 1, 1)
        End If
    
        'Check for list variables. Retrieve lists if found
        iListStart = InStr(strQryLine, "$")
        If iListStart Then
            strListVar = Mid(strQryLine, iListStart, InStr(iListStart + 1, strQryLine, "$") - iListStart + 1)
            strQryLine = Replace(strQryLine, strListVar, getList(strListVar), 1, 1)
        Else
            EndOfLine = True
        End If
        strQry = strQry & strQryLine & vbCr & vbLf
    Wend
    
Wend

ts.Close
fillquery = strQry

Set ts = fs.CreateTextFile("Y:\FTP\users\Excel\test.sql")
ts.write fillquery
ts.Close

Set fs = Nothing
Set ts = Nothing

End Function

Function getList(ByVal listname As String) As String

Dim list As Variant
Dim lists As Worksheet
Dim listHead As Range
Dim i As Integer
'Debug.Assert 0

Set lists = Sheets("Lists")

Set listHead = lists.Range("1:1").Find(listname)
If listHead Is Nothing Then
    getList = listname
    Exit Function
End If
getList = listHead.Offset(1, 0).Value
For i = 2 To Range(listHead.Offset(1, 0), listHead.End(xlDown)).Rows.count
    getList = getList & ", " & listHead.Offset(i, 0).Value
Next i

End Function

Function calculateString(ByVal formula As String) As String

Dim EndOfLine As Boolean
Dim iListStart As Integer
Dim strListVar As String

While EndOfLine <> True

    'Check for list variables. Retrieve lists if found
    iListStart = InStr(formula, "$")
    If iListStart Then
        strListVar = Mid(formula, iListStart, InStr(iListStart + 1, formula, "$") - iListStart + 1)
        formula = Replace(formula, strListVar, getList(strListVar))
    Else
        EndOfLine = True
    End If
Wend

Sheets("Control").Range("calcRange").formula = "=" & Mid(formula, 2, Len(formula) - 2)
Sheets("Control").Range("calcRange").Calculate

formula = Sheets("Control").Range("calcRange").Text
End Function

My issue arises with Replace when using the calculateString function.

If I step through the code, and observe my watch window, I can see the "formula" variable returning the correct value and datatype.

However, the line

strQryLine = Replace(strQryLine, strCalc, calculateString(strCalc), 1, 1)

just ends up being truncated after the position of "strCalc"

So if my strQryLine is "WHERE date > @$WE_DATE$ + 7@" the replace function turns strQryLine to "WHERE date >"

I don't get it, Replace is working in my other function?

 

[PHV]

Replace this:
formula = Sheets("Control").Range("calcRange").Text
with this:
calculateString = Sheets("Control").Range("calcRange").Text

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Gruuuu]

Is there an emoticon for slapping myself upon the head?
Thank you, PHV. I knew you would come through to immediately pick up my obvious mistakes!