HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Extracting and analyzing data from SAP

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
analyzingsapextractingandfromdata

Problem

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

Solution

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.

Code Snippets

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

Context

StackExchange Code Review Q#86224, answer score: 4

Revisions (0)

No revisions yet.