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

[orecchibruno]

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


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:


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

[SamT]

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

[orecchibruno]

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

[Paul_Hossler]

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?

[orecchibruno]

Hi Paul,

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

I upload an Excel example

[orecchibruno]

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'?:


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

[SamT]

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

[Paul_Hossler]

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

[orecchibruno]

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

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

Thankss again, I very appreciate your help

[Paul_Hossler]

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

[SamT]

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.

[SamT]

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.

[orecchibruno]

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

[SamT]

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.

[orecchibruno]

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

[SamT]

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

[orecchibruno]

:blush thank you Sam :blush