Redim doesn't work after script was run successfully

whitehawk81

Board Regular
Joined
Sep 4, 2016
Messages
66
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:

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
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
If you rerun code then everything should be 'reset'.

Where are you getting the error(s)?

What happens if you remove this?

Code:
On Error Goto Hell

PS Putting something like that in the code isn't going to help, in fact it could hinder as it might hide things.
 
Upvote 0
If I remove the On Error statement I get #VALUE ! error.
Actually I put this part there, because there are some cells that don't give any value back and for that I only wanted to give back a string.
 
Upvote 0
If you want to handle the VLookup not returning a result don't use On Error...

Use something like this.
Code:
Function Kwrd(strText As Range) As Variant
Dim 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

Dim Res As Variant

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

    '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)
            
            Res = Application.VLookup(c, myRange, 3, False)
            
            If Not IsError(Res) Then
                solArr(i) = Res
            Else
                solArr(i) = "Not found"
            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
            Kwrd = FindMax(countArr)


        End If
    Next i

End Function

That code uses Application.Vlookup and a variant variable, Res, to avoid the runtime error that could occur if the lookup failed.
 
Upvote 0
Thanks for the help! :) I also reinstated the Redim Preserve for the arrays and now it works fine. Now I only get a value error for this part:
Code:
Else                solArr(i) = "not found"
            End If
I also tried to set the solArr to Variant but it still gives a value error, even if I just set it to a number.
 
Upvote 0
This is just an example, I don't know what you want to put in the array if the lookup fails.
Code:
solArr(i) = "not found"

Perhaps you just want a 0?
Code:
solArr(i) = 0
 
Upvote 0
Yes, I set it to 0 now and even changed the second for loop by checking for isempty:
Code:
For i = LBound(solArr) To UBound(solArr)        
If IsEmpty(solArr) Then
            KwSearch = "not found"
        Else
            '----------------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)
        End If
    Next i
but I still get value error, where the vlookup doesn't return a result.
 
Last edited:
Upvote 0
Where are you getting the 'value' error and why are you using IsEmpty(solArr)?
 
Upvote 0
I only get the 'value' error when the function doesn't find any keywords in the selected range, therefore the vlookup fails.
I used IsEmpty(solArr) to see if the array captures any value after the vlookup, but in this case the code stops at the vlookup.
 
Upvote 0
If you used what I suggested you would not get an error when the vlookup didn't find a key word.
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,771
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top