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.

Code:

---

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

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:

Code:

---

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

---

Is the same as

Code:

---

myResult = returnAddress.Offset(, 1) & returnAddress.Offset(, 2) 'But, without the curly brackets

---

Code:

---

Set returnAddress = Cells.Range(myRange.Address).Find

---

is the same as

Code:

---

Set returnAddress =myRange.Find

---

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

Quote:

---

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?

Hi Paul,

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

I upload an Excel example

Hi Sam,

Quote:

---

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

Quote:

---

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.

Quote:

---

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

Code:

---

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

---

Code:

---

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

---

Code:

---

Function1()
Dim MyVar
MyVar = PrivateFunction
'PrivateFunction Returns a Value
'PrivateFunction can be used anywhere in the Module
End Function

---

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

Code:

---


 
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

---

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. :)

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

Quote:

---

Originally Posted by orecchibruno

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

Code:

---


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

---

Quote:

---

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.

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.

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

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.

Hey guys, thank you again!

Finally I've correct the code:

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:

Code:

---

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

Quote:

---

If someone has a solution to post pone the end of the loop, I'll appreciate to learn it

---

Code:

---

Do While MyPos <= tot
Mypos = MyPos + 1
'
'Blah, Blah
'
'
Tot = tot + 1
Loop

---

:blush thank you Sam :blush