Is there way to reduce a sheet size with 31000 rows for faster seaching by some sort of compressing method?

[chazrab]

Title explains. I use the FIND method in a button click code. The button stays depressed an awfully long time before it produces the
results of a search. Other software apps like mine written in C# give instanteous results with exactly the same 31,103 rows across 4 columns.
Want to keep the development in VBA. Learning curve of C# is to complicated.

thx for any suggestions.
ct

 

[mumps]

That is a huge file! It gave me some error messages when I tried to work with it so I opened a blank Excel workbook and copy/pasted the Sheet2 data into a blank sheet in the new workbook. I then named another sheet as "Result". You have such a large number of macros, sheets and userforms that it would be impractical for me to go through everything. That is why I put the data to search into a new workbook. This allowed me to test some code without getting any errors. The following macro seems to do what you want very quickly. It places all the data that is to be searched and the data which meets the search criteria into memory. It then takes it from memory and places it in the "Result" sheet all at one time. Since the macro works with the data in memory and doesn't have to keep referring to the actual worksheet, the process is very fast. The macro searches for the text "the earth" in column E and when found, it pastes the appropriate data into the "Result" sheet. You would have to change the two occurrences of the search criteria in the macro to suit your needs. Keep in mind that since it searches for a partial match, you may not get the desired results if you search for a single word because that word may be a part of a longer word. I did not attempt to modify your original macro. Hopefully, you will be able to adapt it to suit your needs.
Click here to download your file. With the Data sheet active, run the code in Module1.
This is the code:

Sub Test()
    Application.ScreenUpdating = False
    Dim v As Variant, r As Long, c As Long, arr() As Variant, cnt As Long, x As Long: x = 1
    cnt = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "*the earth*")
    ReDim arr(cnt, 6)
    v = Sheets("Data").Range("B1", Sheets("Data").Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
    For r = LBound(v) To UBound(v)
        If InStr(1, v(r, 3), "the earth") > 0 Then
            For c = LBound(v, 2) To UBound(v, 2)
                arr(x, c) = v(r, c)
            Next c
            x = x + 1
        End If
    Next r
    Sheets("Result").Range("A1").Resize(cnt, 6).Value = arr
    Application.ScreenUpdating = True
End Sub

 

[chazrab]

That is a huge file! It gave me some error messages when I tried to work with it so I opened a blank Excel workbook and copy/pasted the Sheet2 data into a blank sheet in the new workbook. I then named another sheet as "Result". You have such a large number of macros, sheets and userforms that it would be impractical for me to go through everything. That is why I put the data to search into a new workbook. This allowed me to test some code without getting any errors. The following macro seems to do what you want very quickly. It places all the data that is to be searched and the data which meets the search criteria into memory. It then takes it from memory and places it in the "Result" sheet all at one time. Since the macro works with the data in memory and doesn't have to keep referring to the actual worksheet, the process is very fast. The macro searches for the text "the earth" in column E and when found, it pastes the appropriate data into the "Result" sheet. You would have to change the two occurrences of the search criteria in the macro to suit your needs. Keep in mind that since it searches for a partial match, you may not get the desired results if you search for a single word because that word may be a part of a longer word. I did not attempt to modify your original macro. Hopefully, you will be able to adapt it to suit your needs.
Click here to download your file. With the Data sheet active, run the code in Module1.
This is the code:

Sub Test()
    Application.ScreenUpdating = False
    Dim v As Variant, r As Long, c As Long, arr() As Variant, cnt As Long, x As Long: x = 1
    cnt = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "*the earth*")
    ReDim arr(cnt, 6)
    v = Sheets("Data").Range("B1", Sheets("Data").Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
    For r = LBound(v) To UBound(v)
        If InStr(1, v(r, 3), "the earth") > 0 Then
            For c = LBound(v, 2) To UBound(v, 2)
                arr(x, c) = v(r, c)
            Next c
            x = x + 1
        End If
    Next r
    Sheets("Result").Range("A1").Resize(cnt, 6).Value = arr
    Application.ScreenUpdating = True
End Sub

Thanks for spending time on this. The only way I got around finding a single word such as "east" and not include the word "eastward" in the
results is by this :

 x = " " & Me.TextBox6.Value & " "

It seems to work every time. The blank spaces seem to isolate any value of x which works counter to xLPart which is waht I want when
I want tthe code to find a single word. I'm going to study what you sent.

Yes, it's a large file with many forms and buttons, and I suspect a lot of redudancy. I keep getting an"out of memory" message dialog
so I don't know what's working there, even when I close all other apps and tabs and restart the laptop. 16 GB, i7 should be enough memory
I would think.
Again, thanks for your help.
cr

 

[mumps]

You are very welcome.

 

[chazrab]

You are very welcome.

More... wow! instantaneous. You typed "the earth" directly into the code. The input will be in a userform variable with
search options. Below is an idea of what a user will use to get desired result(s). LBound, UBound and instr are things
I've not used b4. Options given as choices to the user in a userform will tell the code how and where to look for any
value of x, either as a phrase, a partial word or single word. So - I should be able to incorporate your code in a FIND button with a userform variable
x as a Textbox value instead of the traditional FIND loop method ?

 

[chazrab]

More... wow! instantaneous. You typed "the earth" directly into the code. The input will be in a userform variable with
search options. Below is an idea of what a user will use to get desired result(s). LBound, UBound and instr are things
I've not used b4. Options given as choices to the user in a userform will tell the code how and where to look for any
value of x, either as a phrase, a partial word or single word. So - I should be able to incorporate your code in a FIND button with a userform variable
x as a Textbox value instead of the traditional FIND loop method ?

I tried to get this to work with a variable s in place of "the earth": Subscript out of range error at bolded line below.
The code is neat and simple. Just don't completely understand. Just when you have a chance, could you please explain
what the values of x, c and r are and do in these lines:

 For c = LBound(v, 2) To UBound(v, 2)
                arr(x, c) = v(r, c)

Why would it give this 'subscript out of range' error? I just did a simple string variable substitution for "the earth"?

Private Sub cmdFIND_Click()
Sheets("Result").UsedRange.ClearContents  ' clears Result sheet.  added 9/15/23 by cr
    Application.ScreenUpdating = False
    Dim v As Variant, r As Long, c As Long, arr() As Variant, cnt As Long, x As Long: x = 1
    Dim s As String  ' variable for assigining value to find in uf textbox1.  added 9/15/23 by cr
    s = Me.TextBox1.Value 'any value of s
    cnt = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "*s*") 'used varaible s to find any value from textbox
'    cnt = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "*the earth*") original code line
    ReDim arr(cnt, 6)
    v = Sheets("Data").Range("B1", Sheets("Data").Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
    For r = LBound(v) To UBound(v)
        If InStr(1, v(r, 3), "s") > 0 Then 'used s variable in place of "the earth"
            For c = LBound(v, 2) To UBound(v, 2)
                arr(x, c) = v(r, c) 'getting "subscript out of range" message at this line
            Next c
            x = x + 1
        End If
    Next r
    Sheets("Result").Range("A1").Resize(cnt, 6).Value = arr
    Application.ScreenUpdating = True
End Sub

All I need to do now is put this in the userform button in the image.

Thx a million.
cr

 

[chazrab]

I tried to get this to work with a variable s in place of "the earth": Subscript out of range error at bolded line below.
The code is neat and simple. Just don't completely understand. Just when you have a chance, could you please explain
what the values of x, c and r are and do in these lines:

 For c = LBound(v, 2) To UBound(v, 2)
                arr(x, c) = v(r, c)

Why would it give this 'subscript out of range' error? I just did a simple string variable substitution for "the earth"?

Private Sub cmdFIND_Click()
Sheets("Result").UsedRange.ClearContents  ' clears Result sheet.  added 9/15/23 by cr
    Application.ScreenUpdating = False
    Dim v As Variant, r As Long, c As Long, arr() As Variant, cnt As Long, x As Long: x = 1
    Dim s As String  ' variable for assigining value to find in uf textbox1.  added 9/15/23 by cr
    s = Me.TextBox1.Value 'any value of s
    cnt = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "*s*") 'used varaible s to find any value from textbox
'    cnt = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "*the earth*") original code line
    ReDim arr(cnt, 6)
    v = Sheets("Data").Range("B1", Sheets("Data").Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
    For r = LBound(v) To UBound(v)
        If InStr(1, v(r, 3), "s") > 0 Then 'used s variable in place of "the earth"
            For c = LBound(v, 2) To UBound(v, 2)
                arr(x, c) = v(r, c) 'getting "subscript out of range" message at this line
            Next c
            x = x + 1
        End If
    Next r
    Sheets("Result").Range("A1").Resize(cnt, 6).Value = arr
    Application.ScreenUpdating = True
End Sub

All I need to do now is put this in the userform button in the image.

Thx a million.
cr

PS: I added Sheets("Data").Activate at the first line of the code, thinking 'subscript out of range' couldn't "see" the Data sheet.
I runs, but it gives very record in Sheet 2 as the Result, all 31103 rows - and doesn't perform the search correctly.
Trying to fix it myself. What am I missing?
cr

 

[MARK858]

If s is a variable then it shouldn't have quotation marks around it

 

[chazrab]

If s is a variable then it shouldn't have quotation marks around it

I tried waht you said without quotes. How would I get this code to run using a variable value from a Userform textbox - the traditional
way apps receive input from a user ? Image

Private Sub cmdFIND_Click()
    Sheets("Result").UsedRange.ClearContents
    Application.ScreenUpdating = False
    Dim v As Variant, r As Long, c As Long, arr() As Variant, cnt As Long, x As Long: x = 1
    Dim s as string
    s = Me.Textbox1.value 
cnt = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), s)
    ReDim arr(cnt, 6)
    v = Sheets("Data").Range("B1", Sheets("Data").Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
    For r = LBound(v) To UBound(v)
        If InStr(1, v(r, 3), s) > 0 Then
            For c = LBound(v, 2) To UBound(v, 2)
                arr(x, c) = v(r, c) '---> subscript out of range error at this line
            Next c
            x = x + 1
        End If
    Next r
    Sheets("Result").Range("A1").Resize(cnt, 6).Value = arr
    Application.ScreenUpdating = True
End Sub

This code goes into the Find button on the userform. Textbox1 is the value to find.
This doesn't seem to work. Subscript out of range error at line indicated.

Please help with this if you can.
Thx cr

 

[chazrab]

You are very welcome.

Hi mumps. To include you in the loop, since you helped me originlly, I'm copying you on a reply from a comment from another user who chimed in.
How would I get this code to run using a variable value from a Userform textbox - the traditional
way apps receive input from a user ? Image

Private Sub cmdFIND_Click()
    Sheets("Result").UsedRange.ClearContents
    Application.ScreenUpdating = False
    Dim v As Variant, r As Long, c As Long, arr() As Variant, cnt As Long, x As Long: x = 1
    Dim s as string
    s = Me.Textbox1.value 
cnt = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), s)
    ReDim arr(cnt, 6)
    v = Sheets("Data").Range("B1", Sheets("Data").Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
    For r = LBound(v) To UBound(v)
        If InStr(1, v(r, 3), s) > 0 Then
            For c = LBound(v, 2) To UBound(v, 2)
                arr(x, c) = v(r, c) '---> subscript out of range error at this line
            Next c
            x = x + 1
        End If
    Next r
    Sheets("Result").Range("A1").Resize(cnt, 6).Value = arr
    Application.ScreenUpdating = True
End Sub

This code goes into the Find button on the userform. Textbox1 is the value to find.
This doesn't seem to work. Subscript out of range error at line indicated.

Please help with this if you can.
Thx cr

 

[mumps]

Try:

Private Sub cmdFIND_Click()
    Sheets("Result").UsedRange.ClearContents
    Application.ScreenUpdating = False
    Dim v As Variant, r As Long, c As Long, arr() As Variant, cnt As Long, x As Long: x = 1
    Dim s As String
    s = Me.TextBox1.Value
    cnt = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "*" & s & "*")
    ReDim arr(cnt, 6)
    v = Sheets("Data").Range("B1", Sheets("Data").Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
    For r = LBound(v) To UBound(v)
        If v(r, 3) Like "*" & s & "*" Then
            For c = LBound(v, 2) To UBound(v, 2)
                arr(x, c) = v(r, c) '---> subscript out of range error at this line
            Next c
            x = x + 1
        End If
    Next r
    Sheets("Result").Range("A1").Resize(cnt, 6).Value = arr
    Application.ScreenUpdating = True
End Sub