I have a piece of code that works for what I need. However, it runs too slow. Through research I found that the "slowness" is coming from constantly accessing the workbook and if I could do the operations from an array it should significantly improve performance speed. I haven't been able to find anything to specifically help me through this. So here is what I got.
My code searches for a string (xlpart) within a cell which will have multiple data entries separated by commas. It'll find that instance and all other instances (and their position within the comma delimited string) and then recombine them into a new string that is comma delimited.
So like I said, this works, but when I apply it to 4000 rows it crushes the CPU. I even tried adding in some 'speeding up' ideas I found like .Calculation and .Screenupdating. The problem I see is in the "Set test =" line. Is there a way to search through an array, find instances of a string, and extract specific information out? Or am I doing this all wrong?
Function FindRef(lookupValue As Range, lookupRange As Range, resultsRange As Range) As String
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim OutputName1 As String
Dim OutputName2 As String
Dim r As Long
Dim test As Range
Dim working1() As String
Dim working2() As String
i = 0
For r = 1 To lookupRange.Rows.Count
Set test = lookupRange.Cells(r, 1).Find(lookupValue.Value, LookIn:=xlValues, lookat:=xlPart)
If Not test Is Nothing Then
working1() = Split(lookupRange.Cells(r, 1), ", ")
For j = LBound(working1) To UBound(working1)
If working1(j) = CheckValue Then
working2() = Split(resultsRange.Cells(r, 1), ", ")
If UBound(working2) > 0 Then
OutputName1 = working2(j)
Else
OutputName1 = resultsRange.Cells(r, 1)
End If
End If
i = i + 1
If i = 1 Then
OutputName2 = OutputName1
Else
OutputName2 = OutputName2 & ", " & OutputName1
End If
OutputName1 = ""
Next j
End If
Next
FindRef = OutputName2
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Function
Updated code:
Function FindRef(lookupValue As Range, lookupRange As Range, resultsRange As Range) As String
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim OutputName1 As String
Dim OutputName2 As String
Dim r As Long
Dim test As Variant
Dim working1() As String
Dim working2() As String
Dim CheckValue As String
Dim data() As Variant
Dim data2() As Variant
CheckValue = lookupValue.Value2
data = lookupRange.Value2
data2 = resultsRange.Value2
i = 0
r = 0
For Each test In data
r = r + 1
If test = CheckValue Then
working1() = Split(data(r, 1), ", ")
For j = LBound(working1) To UBound(working1)
If working1(j) = CheckValue Then
working2() = Split(data2(r, 1), ", ")
If UBound(working2) > 0 Then
OutputName1 = working2(j)
Else
OutputName1 = data2(r, 1)
End If
End If
i = i + 1
If i = 1 Then
OutputName2 = OutputName1
Else
OutputName2 = OutputName2 & ", " & OutputName1
End If
OutputName1 = ""
Next j
End If
Next
FindRef = OutputName2
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Function
Using Range.Find is very slow.
Its much faster to use variant arrays. See my Match vs Find vs Variant Array
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.