Consulting

Results 1 to 18 of 18

Thread: syntax problem with a While nested into a Loop (for an Array)

  1. #1

    syntax problem with a While nested into a Loop (for an Array)

    Hello to everyone I would understand what is my mistake in following code.

    If I enable the MsgBox (SpecialReplace), I see that myResult produces the results that I expect but they will be lost and in Excel I see an error.

    Function SpecialReplace(myRange As Range, myString As String) As Variant
    Application.Volatile
        Dim myArray
        Dim myStringToSearch
        Dim counter As Integer
        Dim counter2 As Integer
        Dim myResult As String
        Dim space As String
        Dim stringfound As Boolean
        Dim previousResult As String
        space = ""
        
        myArray = Split(myString, " ")
        For counter = LBound(myArray) To UBound(myArray)
            myStringToSearch = myArray(counter)
            Dim returnAddress As Range
                Set returnAddress = Cells.Range(myRange.Address).Find(What:=myStringToSearch, LookIn:=xlFormulas, LookAt _
                    :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                    True, SearchFormat:=False)
    
    
                If returnAddress Is Nothing Then
                      stringfound = False
                Else
                      stringfound = True
                End If
                
                'now I search multi-words
                Do While stringfound = True
                    previousResult = SpecialReplace
                    If previousResult > "" Then
                        space = " "
                    End If
                    myResult = Cells(returnAddress.Row, (returnAddress.Column) + 1).Value + " {" + Cells(returnAddress.Row, (returnAddress.Column) + 2).Value + "}"
                    SpecialReplace = SpecialReplace + space + myResult
    'MsgBox (SpecialReplace)
    
                    counter2 = counter + 1
                    myStringToSearch = myStringToSearch + " " + myArray(counter2)
                    'Dim returnAddress As Range
                      Set returnAddress = Cells.Range(myRange.Address).Find(What:=myStringToSearch, LookIn:=xlFormulas, LookAt _
                          :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                          True, SearchFormat:=False)
    
    
                      If returnAddress Is Nothing Then
                         stringfound = False
                         myStringToSearch = ""
                      Else
                         counter = counter + 1
                         myArray(counter) = myStringToSearch
                         SpecialReplace = previousResult
                         space = " "
                      End If
                Loop
        Next
    End Function


    I give you an example of what I would do. Suppose in a cell I have following text

    HTML Code:
    lady beetle panthera tigris panthera
    And I would split them into an Array using the "space" and I would search my words in a Cell Range like this:

    HTML Code:
    beetle
    lady
    lady beetle
    panthera tigris
    panthera 
    bla bla
    If there is "Lady beetle" I don't want to get "lady" and "beetle" so I've created a While but something is wrong

    Please explain me where is my mistake, this is my first VBA script
    Thanksss
    Last edited by orecchibruno; 04-19-2018 at 06:50 AM.

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    Inside the Function, replace the Function name with a temporary value holding Variable. Just before the End Function, set the Function = to the Temporary variable. Break the inner loop out of this Function into it's own Private Function.

    Some Code Notes:
    myResult = Cells(returnAddress.Row, (returnAddress.Column) + 1).Value + " {" + Cells(returnAddress.Row, (returnAddress.Column) + 2).Value + "}"
    Is the same as
    myResult = returnAddress.Offset(, 1) & returnAddress.Offset(, 2) 'But, without the curly brackets


    Set returnAddress = Cells.Range(myRange.Address).Find
    is the same as
    Set returnAddress =myRange.Find
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  3. #3
    Hi Sam,

    thank you for your help.
    I'm a novice, could you please do it so I can learn from your code?

    Thanks in adavance

  4. #4
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    If there is "Lady beetle" I don't want to get "lady" and "beetle" so I've created a While but something is wrong
    Is there a list with the two word entries? How does the macro know that "Lady beetle" is supposed to be kept together?

    Can you post a workbook for testing?
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  5. #5
    Hi Paul,

    yes the list, are simple Excel cells. Each cell has a value.

    I upload an Excel example
    Attached Files Attached Files

  6. #6
    Hi Sam,

    Break the inner loop out of this Function into it's own Private Function.
    You mean that I must I must move following loop into a new 'Private Function'?:

    HTML Code:
                Do While stringfound = True
                    previousResult = SpecialReplace
                    If previousResult > "" Then
                        space = " "
                    End If
                    myResult = Cells(returnAddress.Row, (returnAddress.Column) + 1).Value + " {" + Cells(returnAddress.Row, (returnAddress.Column) + 2).Value + "}"
                    SpecialReplace = SpecialReplace + space + myResult
    'MsgBox (SpecialReplace)
    
                    counter2 = counter + 1
                    myStringToSearch = myStringToSearch + " " + myArray(counter2)
                    'Dim returnAddress As Range
                      Set returnAddress = Cells.Range(myRange.Address).Find(What:=myStringToSearch, LookIn:=xlFormulas, LookAt _
                          :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                          True, SearchFormat:=False)
    
    
                      If returnAddress Is Nothing Then
                         stringfound = False
                         myStringToSearch = ""
                      Else
                         counter = counter + 1
                         myArray(counter) = myStringToSearch
                         SpecialReplace = previousResult
                         space = " "
                      End If
                Loop
    or there is another way to pass the result to previous Loop?

    Please give me a help

  7. #7
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    ou mean that I must I must move following loop into a new 'Private Function'?:
    I would. That way, you can test it independently of the rest.

    Also, since the previous function is a For-Next loop, it will only return the last result of the loop. If you place an exit point in that loop, then it would return the first result.

    or there is another way to pass the result to previous Loop?
    Three ways, Use a Module level Variable; Pass a local Variable "By Ref;" Use the Functions return

    Dim ModLevelVar as String
    
    Function1()
    Call PrivateFunction 'or Private Sub, since the ModLevelVar is already Declared
    'PrivateFunction/Sub sets the value of ModLevelVar at the Module level
    'All Functions and Subs in the Module can use ModLevelVar
    
    DoStuff ModLevelVar
    End Function
    Function1()
    Dim LocalVar
    PrivateFunction(ByRef LocalVar) 'Or Private Sub, since LocalVar is already Declared
    'PrivateFunction/Sub Sets the Value of ByRef Variables outside the function
    'LocalVar can not be used outside Function1
    
    DoStuff to LocalVar
    End Function
    Function1()
    Dim MyVar
    MyVar = PrivateFunction
    'PrivateFunction Returns a Value
    'PrivateFunction can be used anywhere in the Module
    End Function
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  8. #8
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    I think the logic is unnecessarily complicated

    I did this as a user defined worksheet function, but the logic could be incorporated into a sub if you wanted to

    I did have to add some data clean up since A5 had a trailing space which caused the logic to fail

    This does NOT clean the input string (although it could) so if a two word entry has multiple spaces, it would miss

     
    Option Explicit
    
    Function SomeData(S As String, R As Range) As String
        Dim aryData As Variant
        Dim s1 As String, s2 As String
        Dim i As Long, j As Long
        
        'save data
        aryData = R.Value
        s1 = S
            
        'clean data
        For i = LBound(aryData, 1) To UBound(aryData, 1)
            For j = LBound(aryData, 2) To UBound(aryData, 2)
            
                'leading and trailing spaces
                aryData(i, j) = Trim(aryData(i, j))
            
                'in case there are 2 or more spaces
                Do While InStr(aryData(i, j), "  ") > 0
                    aryData(i, j) = Replace(aryData(i, j), "  ", " ")
                Loop
            Next j
        Next i
            
            
        'multiple words first
        For i = LBound(aryData, 1) To UBound(aryData, 1)
            If InStr(aryData(i, 1), " ") > 0 Then
                s2 = vbNullString
                
                'build replacement string by going accross columns, skipping first col
                For j = LBound(aryData, 2) + 1 To UBound(aryData, 2)
                    s2 = s2 & aryData(i, j) & " "
                Next j
                
                'remove last added space
                s2 = Left(s2, Len(s2) - 1)
                s1 = Replace(s1, aryData(i, 1), s2)
            End If
        Next i
        
        'single words
        For i = LBound(aryData, 1) To UBound(aryData, 1)
            If InStr(aryData(i, 1), " ") = 0 Then
                s2 = vbNullString
                
                'build replacement string by going accross columns, skipping first col
                For j = LBound(aryData, 2) + 1 To UBound(aryData, 2)
                    s2 = s2 & aryData(i, j) & " "
                Next j
                
                'remove last added space
                s2 = Left(s2, Len(s2) - 1)
                s1 = Replace(s1, aryData(i, 1), s2)
            End If
        Next i
        
        SomeData = s1
    End Function
    Attached Files Attached Files
    Last edited by Paul_Hossler; 04-19-2018 at 11:09 AM.
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  9. #9
    Hi Sam

    thank you again for your answer. At the moment I would avoid to move inner loop into a new function.

    Can you show me how to pass the variable outiside the loop and sent it to function result?

    PS: sorry but I'm novice and it's faster for me to compare your correction. It will be nice if you can simply correct my code.

  10. #10
    Hi Paul

    thank you. You example is cool and I'll studied but I would also learn my mistake, so it will be nice if you can correct my example so I can learn my mistakes.

    Thankss again, I very appreciate your help

  11. #11
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Quote Originally Posted by orecchibruno View Post
    Hi Paul

    thank you. You example is cool and I'll studied but I would also learn my mistake, so it will be nice if you can correct my example so I can learn my mistakes.

    Thanks again, I very appreciate your help
    I thing the problem was 1 - architectual and 2 - not using built in Excel features and 3 - over complicating it

    Instead of taking pieces of the input sting and checking against the input range, my suggested alternative was to take the input range and check against the input string





    a. Cells.Range(myRange.Address).Find can be simplified to myRange.Find

    b. I don't understand what

    myResult = Cells(returnAddress.Row, (returnAddress.Column) + 1).Value + " {" + Cells(returnAddress.Row, (returnAddress.Column) + 2).Value + "}"

    is supposed to do, but that's a very complicated way to (I think) get something out of a cell in a range

    c. I don't understand why you need to use .Find on the input myRange



    I added your macro (#1) to your test data (#5). It compiles without error, but it's not clear how to run it

    If you can update the attachment with some way (example of driver function below) to run/test it will help look at your logic the way you have it


    Sub Test()
        MsgBox SpecialReplace(ActiveSheet.Range("A1:C6"), ActiveSheet.Range("A10"))
        
    End Sub
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  12. #12
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    It will be nice if you can simply correct my code.
    Your code has no errors. The algorithm is wrong. It is difficult to understand even well designed recursive algorithms, and I can't make sense of yours.

    I just don't know exactly what you are trying to accomplish. Without knowing that, nobody can write code to get there.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  13. #13
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    You are only asking us to fix your While Loop, but, IMO, the While loop is not the problem, IMO, the problem is the Function algorithm.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  14. #14
    Hi Paul and Hi Sam

    I'm cleaning the code as Sam has suggested at his first answer and as you Paul suggested too.

    As you Sam suggested, I've moved the 2nd loop into an other function using
    HTML Code:
    ByRef
    to share data change.

    But it's first Loop that splits string using the "space", so how can I pass the entire Array ?

    Thankss again

  15. #15
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    Pass one piece of the array at a time. That way the inner loop only has to do one thing with one item at a time.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  16. #16
    Hey guys, thank you again!

    Finally I've correct the code:

    Function SpecialReplace(myRange As Range, myString As String) As Variant
    Application.Volatile
        Dim myArray
        Dim myArray2
        Dim currentString As String
        Dim stringToSearch As String
        Dim counter As Integer
        Dim counter2 As Integer
        
        Dim myPos As Integer
        Dim tot As Integer
        Dim mySeparator As String
        Dim stringfound As Boolean
        Dim finalResult As String
        Dim result As String
        Dim myResult As String
        Dim finalTextToCopy As String
           
        myArray = Split(myString, " ")
        For counter = LBound(myArray) To UBound(myArray)
            'start the search
            currentString = ""
            tot = 0
            myPos = 0
            For myPos = 0 To tot
                If currentString = "" Then
                    currentString = myArray(counter)
                End If
                If counter < UBound(myArray) Then
                    counter2 = counter + 1
                    stringToSearch = currentString + " " + myArray(counter2)
                Else
                    stringToSearch = currentString
                End If
                Call performMySearch(stringToSearch, result, myRange)
                'se la trovo
                If finalResult > "" Then
                    mySeparator = "|"
                End If
                If result > "" Then
                    'for a Loop behaviour that I didn't expect, it's worthless to increase Target Loop instead as this:
                    'counter = counter + 1
                    'tot = tot + 1
                    'finalResult = finalResult + mySeparator + stringToSearch
                    'so, I dot this and I move backwards in Previous loop:
                    myArray(counter2) = stringToSearch
                    If counter = UBound(myArray) Then
                        finalResult = finalResult + mySeparator + stringToSearch
                    End If
                    myPos = tot
                Else
                    finalResult = finalResult + mySeparator + currentString
                End If
            Next myPos
            'MsgBox (finalResult)
        Next counter
        'SpecialReplace = finalResult 'this is a new parsed Array using a pipe separator "|"
        
        mySeparator = ""
        myArray2 = Split(finalResult, "|")
        For counter2 = LBound(myArray2) To UBound(myArray2)
            'Dim returnAddress As Range
                Set returnAddress = Cells.Range(myRange.Address).Find(What:=myArray2(counter2), LookIn:=xlFormulas, LookAt _
                    :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                    True, SearchFormat:=False)
                
                If finalTextToCopy > "" Then
                    mySeparator = " "
                End If
                If returnAddress Is Nothing Then
                    finalTextToCopy = finalTextToCopy + mySeparator + "€€€"
                Else
                    myResult = returnAddress.Offset(, 1) & " " & returnAddress.Offset(, 2)
                    finalTextToCopy = finalTextToCopy + mySeparator + myResult
                End If
        Next counter2
        SpecialReplace = finalTextToCopy
    End Function
    Function performMySearch(ByRef stringToSearch, ByRef result, ByVal myRange)
        Dim Space As String
        Dim returnAddress As Range
        Set returnAddress = myRange.Find(What:=stringToSearch, LookIn:=xlFormulas, LookAt _
            :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            True, SearchFormat:=False)
            
        If returnAddress Is Nothing Then
            result = ""
        Else
            result = returnAddress
        End If
    End Function
    I tried using the While but something was wrong, maybe I've encountered following problem that thanks to the Debugger I learned why.
    I see that is not allowed to change the End of Loop while is still in progress:

    For myPos = 0 To tot
        'do something
        'for some reason encrease target Loop, but it doesn't work
        If result > "" Then
            tot = tot + 1
        EndIf
    Next myPos
    If someone has a solution to post pone the end of the loop, I'll appreciate to learn it

    Thanks again
    Last edited by orecchibruno; 04-24-2018 at 07:48 AM.

  17. #17
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    If someone has a solution to post pone the end of the loop, I'll appreciate to learn it
    Do While MyPos <= tot
    Mypos = MyPos + 1
    '
    'Blah, Blah
    '
    '
    Tot = tot + 1
    Loop
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  18. #18
    thank you Sam

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •