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()
\$\endgroup\$
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.

\$\endgroup\$
  • \$\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\$ – PetLahev Apr 8 '15 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

\$\endgroup\$
  • \$\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\$ – PootyToot Apr 8 '15 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\$ – Dan Donoghue Apr 8 '15 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\$ – PootyToot Apr 8 '15 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\$ – Dan Donoghue Apr 8 '15 at 5:58

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.