4
\$\begingroup\$

I developed a script for the company I work for in order to extract data from SAP (CJ74) and analyze the data.

One particular issue I am finding is that for any data sets which have over 1000 lines, it struggles to execute the section of code below, therefore I am searching for answers.

This code takes free hand text from cells in Column J into an array, it then splits the text up and tries to find matches to first and last names located in Column F and G.

This works functionally but it runs like a slug with data sets over 1000 lines, and potentially crashes the program if there are data sets which are at 3000 - 4000 lines and above. Why would this be the case? Have I coded this inefficiently or is this one of VBA's gotchas? If so would there be a better way to write this code?

Option Compare Text
Option Explicit
Sub Loader()
Dim I As Long, J As Long
Dim T As Variant
Dim match_txt As String
'** Takes text from Column J and wraps it into an array**
 For I = 2 To Range("E50000").End(xlUp).row
 typ = Range("F" & I).Value
 If typ = "" Then
 txt = Range("J" & I).Value
 '** Split array into separate lines **
 txtArray = Split(txt, " ")
 '** Check Column F for matches, if it finds a match, put the matching text into column F under the assumption that it is a first name **
 For Each T In txtArray
 For J = 2 To Range("F50000").End(xlUp).row
 If Range("F" & J).Value = T Then
 match_txt = T
 Range("F" & I).Value = match_txt
 End If
 Next J
 Next T
 '** Check Column G for matches, if it finds a match, put the matching text into column G under the assumption that it is a last name **
 For Each T In txtArray
 For J = 2 To Range("F50000").End(xlUp).row
 If Range("G" & J).Value = T Then
 match_txt = T
 Range("G" & I).Value = match_txt
 End If
 Next J
 Next T
 End If
Next I
End Sub()
200_success
145k22 gold badges190 silver badges478 bronze badges
asked Apr 8, 2015 at 4:43
\$\endgroup\$

2 Answers 2

4
\$\begingroup\$

You can move the range values first to the array before doing your loops.
You can try below:

Dim tbArray, fcArray, gcArray ' Variant type
Dim elr As Long, flr As Long, glr As Long, i As Long
Dim T
With Sheets("YourSheetName") ' always be explicit when working with objects
 elr = .Range("E" & .Rows.Count).End(xlUp).Row
 flr = .Range("F" & .Rows.Count).End(xlUp).Row
 'glr = .Range("G" & .Rows.Count).End(xlUp).Row
 tbArray = .Range("F2:J" & elr) ' pass Range values, arr becomes 2D array
 fcArray = .Range("F2:F" & flr) ' creates horizontal 2D array but regardless
 gcArray = .Range("G2:G" & flr) ' this will be used for matching only
 For i = LBound(tbArray, 1) To UBound(tbArray, 1)
 If Len(tbArray(i, 1)) = 0 Then ' you can use tbArray(i, 1) = "", just preference
 For Each T In Split(tbArray(i, 5), " ")
 If Not IsError(Application.Match(T, fcArray, 0)) Then
 tbArray(i, 1) = T ' corresponds to F
 ElseIf Not IsError(Application.Match(T, gcArray, 0)) Then
 tbArray(i, 2) = T ' corresponds to G
 End If
 Next
 End If
 Next
 .Range("F2:J" & elr) = tbArray ' return the array to range
End With

This is compiled but not tested. We took advantage of using the Match Function.
You based your last rows to Columns E, F and G respectively so I just mimicked that.
No idea on how much data it can handle, but a 10K wouldn't hurt I guess.

answered Apr 8, 2015 at 7:23
\$\endgroup\$
1
  • \$\begingroup\$ +1 for the array transformation. I didn't check the suggested code but from my experience 'talking' directly to cell is the one of the biggest time consumer in VBA. I bet the suggested change will improve the performance significantly (I remember once I was going through ~100k cells and it took almost one hour to finish, when converted to array it took less than few seconds - cpearson.com/excel/ArraysAndRanges.aspx \$\endgroup\$ Commented Apr 8, 2015 at 10:37
2
\$\begingroup\$

The reason it is slow is because of the exponential growth of the requests.

If you have 10 words in txt and 50 values in F and G respectively you are doing 1000 comparisons however if each has 1000 values you are doing 2,000,000 comparisons.

An alternative solution would be rather than looping each word in J is to compare the len of txt with the len of txt where Range("F" & J).Value has been replaced with nothing. If the Len is different then you have a match, this way you still loop F for as many rows as there are but only once as opposed to looping all rows of F as many times are there are words in txt.

Does that make sense? Happy to knock up an example if you need.

Here is the example of your code modified with these changes:

Option Compare Text
Option Explicit
Sub Loader()
Dim I As Long, J As Long, txt As String
 For I = 2 To Range("E" & Rows.Count).End(xlUp).Row
 If Range("F" & I).Value = "" Then
 txt = Range("J" & I).Value
 '** Check Column F & G for matches, if it finds a match, put the matching text into column F under the assumption that it is a first name **
 For J = 2 To Range("F" & Rows.Count).End(xlUp).Row
 If Len(txt) <> Len(Replace(txt, Range("F" & J).Value, "")) Then Range("F" & I).Value = Range("F" & J).Value
 If Len(txt) <> Len(Replace(txt, Range("G" & J).Value, "")) Then Range("G" & I).Value = Range("G" & J).Value
 Next J
 End If
 Next I
End Sub

So we check the length of txt then we substitute columns Fs text with nothing in our txt string and compare the length of that against the original length.

Basically we are just checking if column F exists in txt

answered Apr 8, 2015 at 5:02
\$\endgroup\$
4
  • \$\begingroup\$ I am a bit lost when you mention the len of text, the idea of taking the text and splitting it is to compare the text as individual keywords. In your case I will be comparing the entire string, the issue here is that the text could be in any order. Could you show an example? \$\endgroup\$ Commented Apr 8, 2015 at 5:09
  • \$\begingroup\$ OK So the concept is this: Compare the length of the string (txt) to the length of the string (txt) with the string from Column F (or G) replaced with nothing and update if there is a difference. I have posted an example of your code modified with this chage in my original answer, let me know if it works. \$\endgroup\$ Commented Apr 8, 2015 at 5:25
  • 1
    \$\begingroup\$ I am compiling this line of code and executing it, it still does not respond, but I can see where you are coming from now, it would work well if you did a match on the length of text as a shortcut, except in this case it did not pass the stress test. I will work with your code further and see if I can come to a positive result \$\endgroup\$ Commented Apr 8, 2015 at 5:55
  • \$\begingroup\$ Awesome, post back if you have specific questions about the code, more than happy to help in any way I can. Maybe a little sample data would help for testing too. \$\endgroup\$ Commented Apr 8, 2015 at 5:58

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.