Redim doesn't work after script was run successfully

[whitehawk81]

Hi there,
I managed to run the script only once without error. But now I get a value error and it seems that the Redim is not resizing the arrays.
Originally I used Redim Preserve but after the error I also tried to resize them at the initialization, but neither of them seems to work now.
Here is my code:

Function Kwrd(strText As Range) As VariantDim c As Range
Dim i As Long
Dim sID As Long
Dim sCount As Long
Dim solArr() As Long
Dim countArr() As Long
Dim Words As Range
Dim myRange As Range
Set Words = Range("kw")
Set myRange = Range("kwmap")


On Error GoTo Hell


'ReDim solArr(1 To UBound(solArr))
'ReDim countArr(1 To UBound(countArr))
    
For Each c In Words
    If InStr(1, strText, c, 1) > 0 Then
    
    '----------------found keywords are mapped and replaced with solution ID
    'ReDim Preserve solArr(i)
    solArr(i) = Application.WorksheetFunction.VLookup(c, myRange, 3, False)


    i = i + 1
   
    End If
Next c


For i = LBound(solArr) To UBound(solArr)
If solArr(i) <> 0 Then
'----------------same values are counted
    For sID = 1 To 10
    'ReDim Preserve countArr(sID)
        countArr(sID) = CountArray(solArr, sID)
    Next sID


'----------------result is set to ID with max value
    Kwrd = FindMax(countArr)


End If
Next i


Hell:
Kwrd = "No keyword found."


End Function
Private Function CountArray(Arr() As Long, ToFind As Long) As Long
Dim i As Long
    For i = LBound(Arr) To UBound(Arr)
        If Arr(i) = ToFind Then
            CountArray = CountArray + 1
        End If
    Next
End Function
Private Function FindMax(Arr() As Long) As Long
Dim myMax As Long
Dim i As Long
  
  For i = LBound(Arr) To UBound(Arr)
    If Arr(i) > myMax Then
      myMax = Arr(i)
      FindMax = i
    End If
  Next i
End Function

 

[whitehawk81]

Actually I'm using what you suggested, but it still gives me a 'value' error, if no keywords are found.

Function KwSearch(strText As Range) As VariantDim c As Range
Dim i As Long
Dim sID As Long
Dim sCount As Long
Dim solArr() As Variant
Dim countArr() As Long
Dim Words As Range
Dim myRange As Range


Dim Res As Variant


    Set Words = Range("kw")
    Set myRange = Range("kwmap")


    For Each c In Words
        If InStr(1, strText, c, 1) = 0 Then
             Res = 0
        Else
            '----------------found keywords are mapped and replaced with solution ID
            ReDim Preserve solArr(i)
            
            Res = Application.VLookup(c, myRange, 3, False)
            
            If Not IsError(Res) Then
                solArr(i) = Res
            Else
                solArr(i) = 0
            End If


            i = i + 1


        End If
    Next c


    For i = LBound(solArr) To UBound(solArr)
        If solArr(i) <> 0 Then
            '----------------same values are counted
            For sID = 1 To 10
                ReDim Preserve countArr(sID)
                countArr(sID) = CountArray(solArr, sID)
            Next sID




            '----------------result is set to ID with max value
            KwSearch = FindMax(countArr)
            Else
            KwSearch = "not found"
        End If
    Next i


End Function

 

[Norie]

Where do you get the 'value' error?

 

[whitehawk81]

I get the 'value' error, when the InStr function cannot find a string in the selected range.

 

[Norie]

InStr does not search for strings in a range it searches for a substring in a string.

Is the 'value' error a runtime error?

If so what's the exact error message?

 

[whitehawk81]

I don't get a runtime error. I get the 'value' error in the cell. The detailed error is: Error in value. A value used in the formula is of the wrong data type.
I also tried to catch the error by evaluating the InStr function for 0 value, but still get the same 'value' error.

For Each c In Words        If InStr(1, strText, c, 1) = 0 Then
            KwSearch = "Not found"
        Else
            '----------------found keywords are mapped and replaced with solution ID
            ReDim Preserve solArr(i)
            
            Res = Application.VLookup(c, myRange, 3, False)
            
            If Not IsError(Res) Then
                solArr(i) = Res
            End If
            i = i + 1
        End If
    Next c

 

[Norie]

Is this code part of a UDF that you are using in a formula in a cell?

 

[whitehawk81]

Yes, and it works fine, except when it doesn't find a substring in the selected string range.

 

[Norie]

Can you post some sample data and a sample formula that uses the UDF so I can test it out?

 

[whitehawk81]

Sure, how can I share it with you? I cannot find any upload option in the advanced editor.

 

[Norie]

You could upload a sample workbook to a file-sharing site like Box.net and then post a link here.