*For loop efficiency*

[access09]

I have to following code to loop a large amount of data in an excel spreadsheet. However it takes a very long time to loop through the data( around 8 minutes) and produce a result.

In the code I pick one entry from spreadsheet one to loop through spreadsheet two entries and find any entries to contain a reference to it.

The entry from Spreadsheet one used for the loop is: 'AZ-567887'

A sample entry in spreadsheet two that is looped through is: 'Heeny Eamon, AZ-345342, LK TANK' and another one is: 'Thomas-TZ679001-escape of water (GAB)'

option explicit

Sub do_check2()

Dim i As Integer, j As Integer, k As Integer
Dim first_string As String
Dim str_length As Integer
Dim column_array() As Integer
Dim vnt_temp As Variant
Dim array_index As Integer
Const column_numbers = "2,3,8,9,14,15,20,21,26,27"

' Create an array of the column numbers you are interested in
vnt_temp = Split(column_numbers, ",")
ReDim column_array(0 To UBound(vnt_temp))
For array_index = 0 To UBound(vnt_temp)
    column_array(array_index) = vnt_temp(array_index)
Next

' Now do your loop
For i = 2 To 30002
  For j = 2 To 2
    ' At this point we can save the items that are only variable with respect to j rather than processing them each time
    first_string = remove_characters(UCase(Sheets(1).Cells(j, 3).Value))
    str_length = Len(Sheets(1).Cells(j, 3).Value)
    For k = 1 To Len(Sheets(3).Cells(i, 3).Value)

      ' Now cycle through all your columns
      For array_index = 0 To UBound(column_array)

        If first_string = remove_characters(UCase(Mid(Sheets(3).Cells(i, column_array(array_index)).Value, k, str_length))) Then
          Sheets(1).Cells(j, 3).Value = "x"
          Sheets(3).Cells(i, column_array(array_index) + 3).Value = "y"
        End If

      Next array_index

    Next k
  Next j
Next i
End Sub

Function remove_characters(value_in)
value_in = Replace(value_in, " ", "")
value_in = Replace(value_in, "-", "")
value_in = Replace(value_in, ".", "")
value_in = Replace(value_in, "/", "")
remove_characters = value_in
End Function

So, I transfered to data from the excel spreadsheet into ms access in the hope I can run quicker. However, I have never used VBA in access before. Could anyone help me and tell me the changes I need to make to the code above to allow it to run in access?

 

[gemma-the-husky]

you shouldnt need code

if you can import the table into access, then a "like" query should find the data.

similar to an F3/Find search in excel

 

[access09]

that would not work!! The entry in table1 is an account number and the entry in table2 is an account description that has the account number in it. See the entry examples above in my first post.

 

[namliam]

Can still use a query...

Like "*" & "AZ-567887" & "*"

Dont dismiss an idea on sight if you dont understand the suggestion (completely)

 

[access09]

oh ok. But there is actually 60,000 records in table1 that I need to see if it is referenced in table2. Is there still a way to use that query.

 

[access09]

That query did not work for that account number by the way

 

[DALeffler]

One of the reasons the code is slow is because of the K loop and the Mid function within the K loop. Searching for a string within a string should be much faster using the Instr function. What I would try is something like the following on a copy of the workbook:

option explicit

Sub do_check2()

Dim i As Integer, j As Integer, k As Integer
Dim first_string As String
'No need for str_length if no K loop...
'Dim str_length As Integer
Dim column_array() As Integer
Dim vnt_temp As Variant
Dim array_index As Integer
Const column_numbers = "2,3,8,9,14,15,20,21,26,27"

' Create an array of the column numbers you are interested in
vnt_temp = Split(column_numbers, ",")
ReDim column_array(0 To UBound(vnt_temp))
For array_index = 0 To UBound(vnt_temp)
    column_array(array_index) = vnt_temp(array_index)
Next

' Now do your loop
For i = 2 To 30002
  For j = 2 To 2
    ' At this point we can save the items that are only variable with respect to j rather than processing them each time
    first_string = remove_characters(UCase(Sheets(1).Cells(j, 3).Value))
    'str_length = Len(Sheets(1).Cells(j, 3).Value)
    'bypass K loop...
    'For k = 1 To Len(Sheets(3).Cells(i, 3).Value)

      ' Now cycle through all your columns
      For array_index = 0 To UBound(column_array)
        
        'If first_string = remove_characters(UCase(Mid(Sheets(3).Cells(i, column_array(array_index)).Value, k, str_length))) Then
         If InStr(1, remove_characters(UCase(Sheets(3).Cells(i, column_array(array_index)).Value)), first_string) > 0 Then
          Sheets(1).Cells(j, 3).Value = "x"
          Sheets(3).Cells(i, column_array(array_index) + 3).Value = "y"
        End If

      Next array_index

    'Next k
  Next j
Next i
End Sub

Function remove_characters(value_in)
value_in = Replace(value_in, " ", "")
value_in = Replace(value_in, "-", "")
value_in = Replace(value_in, ".", "")
value_in = Replace(value_in, "/", "")
remove_characters = value_in
End Function

With the code as originally posted, the code is performing 30002 multiplied by the number of columns to be searched multiplied by the average number of characters in each cell of sheet(3) iterations.

Using the code modifications, the code will iterate "only" 30002 multiplied by the number of columns to be searched times. The code still won't finish in micro-seconds but I'd almost bet that it will now finish in seconds rather than minutes.

hth & post back for problems,

Doug.

 

[access09]

Thanks. It works much faster now. It does it in about 10/15 seconds!!