patternMinor
Extracting and analyzing data from SAP
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
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:
This is compiled but not tested. We took advantage of using the
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.
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 WithThis 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 WithContext
StackExchange Code Review Q#86224, answer score: 4
Revisions (0)
No revisions yet.