excel crashing when running code

pwwato

New Member
Joined
Jun 10, 2017
Messages
40
Hi
Thanks for taking a look at this and any suggestions given..
I have a create then search array function that work perfectly if i omit 3 lines of code but crashes if they are included, can anyone help with why? and how to resolve it please i could run it ok without but would prefer to have it working with these included

Code:
Public Function create_array(TBook As String, TSheet As String, ByRef TRange As Range, TMatch As String, DO2T As Integer, ByRef TArray As Variant) As Variant


Dim lastrow As String

Application.Workbooks(TBook).Sheets(TSheet).Activate
With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

If DO2T = 1 Then
        .UsedRange.Select
Set TRange = Selection.CurrentRegion
        TArray = TRange.Value
        Application.Workbooks(TBook).Sheets(TSheet).Range("A1").Select
        
        
ElseIf DO2T = 2 Then

Set TRange = TRange.Resize(lastrow, TRange.Columns.Count)
    TArray = TRange
    
ElseIf DO2T = 3 Then

Set TRange = TRange.Resize(lastrow, TRange.Columns.Count)
    TArray = TRange
    
Dim matchArrIndex As Variant, splitArr As Variant
Dim i As Integer, outerindex As Integer, innerIndex As Integer, tempArrayIndex As Integer, CurrIndex As Integer, stringLength As Integer, MType As Variant
Dim increaseIndex As Boolean
Dim actualStr As String

splitArr = Split(TMatch, "*")
On Error GoTo errorHandler
If UBound(splitArr) = 0 Then
MType = 0 'Exact Match
actualStr = TMatch
ElseIf UBound(splitArr) = 1 And splitArr(1) = "" Then
MType = 1 'Starts With
actualStr = splitArr(0)
ElseIf UBound(splitArr) = 1 And splitArr(0) = "" Then
MType = 2 'ends With
actualStr = splitArr(1)
ElseIf UBound(splitArr) = 2 And splitArr(0) = "" And splitArr(2) = "" Then
MType = 3 'contains
actualStr = splitArr(1)
Else
MsgBox "Incorrect match provided"
Exit Function
End If
'start index
i = LBound(TArray, 1)
'resize array for matched values
ReDim matchArrIndex(LBound(TArray, 1) To UBound(TArray, 1)) As Variant
'outer loop
For outerindex = LBound(TArray, 1) To UBound(TArray, 1)
'inner loop
For innerIndex = LBound(TArray, 2) To UBound(TArray, 2)
'if string matches with array elements
If (MType = 0 And TArray(outerindex, innerIndex) = actualStr) Then
'Or _                                                                                                                       [COLOR=#ff0000]''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''[/COLOR]
    (MType = 1 And Left(TArray(outerindex, innerIndex), Len(actualStr)) = actualStr) Or _     [COLOR=#ff0000]These are the  lines that fail if i run as is? it works, if i remove the then from above[/COLOR]
    (MType = 2 And Right(TArray(outerindex, innerIndex), Len(actualStr)) = actualStr) Or _   [COLOR=#ff0000]and move the or _ up and include in code it crashes and shuts excel[/COLOR]
    (MType = 3 And InStr(TArray(outerindex, innerIndex), actualStr) <> 0) Then                 [COLOR=#ff0000]''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''[/COLOR]
increaseIndex = True
matchArrIndex(i) = outerindex
End If
Next
If increaseIndex Then
tempArrayIndex = tempArrayIndex + 1
increaseIndex = False
i = i + 1
End If
Next
'if no matches found, exit the function
If tempArrayIndex = 0 Then
Exit Function
End If
If LBound(TArray, 1) = 0 Then
tempArrayIndex = tempArrayIndex - 1
End If
'resize temp array
ReDim temparray(LBound(TArray, 1) To tempArrayIndex, LBound(TArray, 2) To UBound(TArray, 2)) As Variant
CurrIndex = LBound(TArray, 1)
Dim j As Integer
j = LBound(matchArrIndex)
'store values in temp array
For i = CurrIndex To UBound(temparray)
For innerIndex = LBound(TArray, 2) To UBound(TArray, 2)
temparray(i, innerIndex) = TArray(matchArrIndex(j), innerIndex)
Next
j = j + 1
Next
TArray = temparray
Exit Function
errorHandler:
MsgBox "Error :" & Err.Description

End If
End With
End Function
.

Again thanks for any help or suggestions.
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Hi
Is everyone as puzzled as i am or have i just not put enough info for any help? im leaving it for now and moving on but i would like to sort it so any help appreciated.
 
Upvote 0

Forum statistics

Threads
1,214,611
Messages
6,120,510
Members
448,967
Latest member
screechyboy79

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