Excel VBA: Run time error 7: Out of Memory - macos

Question

I would appreciate if anybody can help me with this issue I am having. Basically, the VBA is a search function that enables the user to search part of or the entire name of the job, from a job database.
However, it results in "Runtime error 7: Out of Memory." This happens only on my Macbook, and does not happen on a Windows computer. Upon clicking "debug", it brought me to this line of code:
`If scd.Cells(i, j) Like "*" & Search & "*" Then
please help! Thank you!
The rest of the code is below:
Option Compare Text
Sub SearchClientRecord()
Dim Search As String
Dim Finalrow As Integer
Dim SearchFinalRow As Integer
Dim i As Integer
Dim scs As Worksheet
Dim scd As Worksheet
Set scs = Sheets("Client Search")
Set scd = Sheets("Client Database")
scs.Range("C19:S1018").ClearContents
Search = scs.Range("C12")
Finalrow = scd.Range("D100000").End(xlUp).Row
SearchFinalRow = scs.Range("D100000").End(xlUp).Row
For j = 3 To 19
For i = 19 To Finalrow
If scd.Cells(i, j) Like "*" & Search & "*" Then
scd.Range(scd.Cells(i, 3), scd.Cells(i, 19)).Copy
scs.Range("C100000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
End If
Next i
Next j
scs.Range("C19:S1018").Select
scs.Range("$C$18:$S$1009").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
, 7), Header:=xlYes
Call Border
Columns("C:S").HorizontalAlignment = xlCenter
End Sub

Answer 1

I created an alternate function called "aLike" below.
In your code you would use it by saying: If aLike("*" & Search & "*",scd.Cells(i, j)) Then
I can't guarantee it works exactly the same way, but I would be interested to see if the Mac can process this function better than "like".
Function aLike(asterixString As Variant, matchString As Variant, Optional MatchCaseBoolean As Boolean) As Boolean
Dim aStr As Variant, mStr As Variant, aStrList As New Collection
Dim i As Long, aPart As Variant, mPart As Variant, TempInt As Long, aStart As Boolean, aEnd As Boolean
aStr = asterixString: mStr = matchString
If Not MatchCaseBoolean Then aStr = StrConv(aStr, vbLowerCase): mStr = StrConv(mStr, vbLowerCase)
' Get rid of excess asterix's
While InStr(aStr, "**") > 0
aStr = Replace(aStr, "**", "*")
Wend
' Deal with trivial case
If aStr = mStr Then aLike = True: GoTo EndFunction
If aStr = "*" Then aLike = True: GoTo EndFunction
If Len(aStr) = 0 Then aLike = False: GoTo EndFunction
' Convert to list
aStart = Left(aStr, 1) = "*": If aStart Then aStr = Right(aStr, Len(aStr) - 1)
aEnd = Right(aStr, 1) = "*": If aEnd Then aStr = Left(aStr, Len(aStr) - 1)
aLike_Parts aStr, aStrList
' Check beginning
If Not aStart Then
aPart = aStrList.Item(1)
If Not (aPart = Left(mStr, Len(aPart))) Then aLike = False: GoTo EndFunction
End If
' Check end
If Not aEnd Then
aPart = aStrList.Item(aStrList.Count)
If Not (aPart = Right(mStr, Len(aPart))) Then aLike = False: GoTo EndFunction
End If
' Check parts
mPart = mStr
For i = 1 To aStrList.Count
aPart = aStrList.Item(i): TempInt = InStr(mPart, aPart)
If TempInt = 0 Then aLike = False: GoTo EndFunction
mPart = Right(mPart, Len(mPart) - TempInt - Len(aPart) + 1)
If Len(mPart) = 0 And i < aStrList.Count Then aLike = False: GoTo EndFunction
Next i
aLike = True
EndFunction:
Set aStrList = Nothing
End Function
Function aLike_Parts(Str As Variant, StrList As Collection) As Variant
Dim Char As String, wPart As String
For i = 1 To Len(Str)
Char = Mid(Str, i, 1)
If Char = "*" Then
StrList.Add wPart: wPart = ""
Else
wPart = wPart & Char
End If
Next i
If Len(wPart) > 0 Then StrList.Add wPart
End Function
Good Luck!

Answer 2

#Alex P , now .find is NOT more efficient, for example :
Option Explicit
Option Compare Text
Sub SearchClientRecord()
With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Dim Search As String
Dim Finalrow As Long
Dim SearchFinalRow As Long
Dim i&, j&
Dim scs As Worksheet
Dim scd As Worksheet
Dim DATA() As Variant
Dim Range_to_Copy As Range
Set scs = Sheets("Client Search")
Set scd = Sheets("Client Database")
With scd
Finalrow = .Range("D100000").End(xlUp).Row
DATA = .Range(.Cells(19, 3), .Cells(Finalrow, 19)).Value2
End With
With scs
.Range("C19:S1018").ClearContents
Search = .Range("C12").Value
SearchFinalRow = .Range("D100000").End(xlUp).Row
End With
With scd
For j = 3 To 19
For i = 19 To Finalrow
If InStr(DATA(i, j), Search) > 0 Then
'If scd.Cells(i, j) Like "*" & Search & "*" Then
If Not Range_to_Copy Is Nothing Then
Set Range_to_Copy = Union(Range_to_Copy, .Range(.Cells(i, 3), .Cells(i, 19)))
'scd.Range(scd.Cells(i, 3), scd.Cells(i, 19)).Copy
'scs.Range("C100000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
Else
Set Range_to_Copy = .Range(.Cells(i, 3), .Cells(i, 19))
End If
End If
Next i
Next j
End With 'scd
Erase DATA
With scs
Range_to_Copy.Copy _
Destination:=.Range("C100000").End(xlUp).Offset(1, 0) '.PasteSpecial xlPasteFormulasAndNumberFormats
.Range("C19:S1018").Select 'this line might be superflous
.Range("$C$18:$S$1009").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7), Header:=xlYes
End With
Call Border
Columns("C:S").HorizontalAlignment = xlCenter 'on wich worksheet ??
Set Range_to_Copy = Nothing
Set scs = Nothing
Set scd = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub