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

chazrab

Well-known Member
Joined
Oct 21, 2006
Messages
911
Office Version
  1. 365
Platform
  1. Windows
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
 
Hi mumps,
this
Code:
.Count).End(xlUp)), "*" & s & "*")
and this
 Like "*" & s & "*" Then
works, but selects all occurrences of a word or string, within part of a word as well as the stand alone word.
In the sentence,
"He moved his family eastward and then settled near the eastern border. He lived a good ife in this land of the east
where he met others who also were east of their homes."

The code selects eastward, eastern, east and east. I just need to figure how the widcards, asteriks and quotes would be placed
to give only the single word east in this case. I worked 8 hours on this and still can't get the wildcard pattern to work
right.
AS prev mentoned, this works, but it's in a Find method Do loop, not an array:
Code:
  Y = " " & Me.TextBox7.Value & " "  <---finds any single value.  
                     With Worksheets("Sheet2").Range("C1:C31103")
                      Set c = .Find(Y, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
                                     If Not c Is Nothing Then
                                         Me.TextBox8.Visible = True
                                        rw = 1



Thx, cr
 
Upvote 0

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Hi again mumps, to include you in the loop, since you've greatly helped me in this speed effort, I just posted a new message
on the forum asking for help with the correct wildcard pattern above. I do not know how to copy you in on this new thread so
I'm just letting you know. Hope this is OK with you.
Here's the message title:

Using wildcards in a pattern iusing a variable s i n a text string to find a single value​

I feel like I'm almost there with the speed issue - I just want to get this wildcard pattern using a variable correct so I can
continue wirh refining the development of this beta app version.
Thanks again for all your help.
cr
 
Upvote 0
See if this works for you:
VBA Code:
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, f As Long, e As Long
    Sheets("Result").UsedRange.ClearContents
    v = Sheets("Data").Range("B1", Sheets("Data").Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
    s = Me.TextBox1.Value
    If InStr(1, s, " ") > 0 Then
        cnt = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "*" & s & "*")
        ReDim arr(cnt, 6)
        For r = LBound(v) To UBound(v)
            If v(r, 4) Like "*" & s & "*" 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
    Else
        s = Me.TextBox1.Value
        cnt = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "* " & s & " *")
        ReDim arr(cnt, 6)
        For r = LBound(v) To UBound(v)
            If InStr(1, " " & v(r, 4) & " ", " " & s & " ", vbTextCompare) > 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
    End If
    Sheets("Result").Range("A1").Resize(cnt, 6).Value = arr
    Unload Me
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
HI mumps. Tested it 3- 4x's and it works great. The only thing I added was this line
Code:
  Sheets("Data").Activate
as the first line because it gives an error message at this line
Code:
     arr(x, c) = v(r, c) ---> subscript out of range
if the code is run from any other sheet.
The only way I can get it to run without activating the Data sheet first is if its run directly from that sheet. Suspected your code couldn't "see"
the Data sheet. Activating it as the top line seems to resolve the problem. This is a lot of code and you've been most helpful.
I don't understand everything you did in each line as to how this code performs the search and refines it to give the desired result.
Putting MsgBox's after each line, might give me an idea on what's being done. I've never had to use Debug Step In, if that would show
the code operating 1 line at a time

Thanks again for all your help.
cr
 
Upvote 0
You are very welcome. :) I should mention that the code isn't perfect. For example, if you search for the word "east" and the word is at the end of a sentence and followed by a period and not a space, "east.", it won't be picked up. If this becomes a problem, we might be able to come up with a "work-around".
 
Upvote 0
You are very welcome. :) I should mention that the code isn't perfect. For example, if you search for the word "east" and the word is at the end of a sentence and followed by a period and not a space, "east.", it won't be picked up. If this becomes a problem, we might be able to come up with a "work-around".
Hi mumps - I typed 'east' in the Find userform textbox(Textbox1 - image below). I knew there was a sentence that ends with 'east' and a period followed by a space and the chapter and verse - and you're 100% correct - it didn't pick it up.
You are very welcome. :) I should mention that the code isn't perfect. For example, if you search for the word "east" and the word is at the end of a sentence and followed by a period and not a space, "east.", it won't be picked up. If this becomes a problem, we might be able to come up with a "work-around".
Hi mumps
You're absolutely correct - the code as is did not pick up east at the end of this sentence:
29:1 Then Jacob went on his journey, and came to the land of the sons of the east. Genesis 29:1 (NASB)

There are 117 occurreces of the single word 'east' in the middle of text, and 20 such occurences in all 31,103 rows where the word 'east' ends a verse with a period after. The accurate result then would be 117+20 = 137 occlurrences of the single word 'east' no matter at what location in the text the word is.

Is it possible to modify this code to include' east.' at the end of a sentence?

Thanks again for all your help. This is a major major breakthrough in the refinement of this app.
cr


You are very welcome. :) I should mention that the code isn't perfect. For example, if you search for the word "east" and the word is at the end of a sentence and followed by a period and not a space, "east.", it won't be picked up. If this becomes a problem, we might be able to come up with a "work-around".
 

Attachments

  • east. AS A PHRASE WITH A PERIOD.png
    east. AS A PHRASE WITH A PERIOD.png
    144.2 KB · Views: 6
Upvote 0
Give this version a try.
VBA Code:
Private Sub cmdFIND_Click()
    Sheets("Result").UsedRange.ClearContents
    Application.ScreenUpdating = False
    Dim s As String, v As Variant, r As Long, c As Long, arr() As Variant, cnt As Long, cnt1 As Long, cnt2 As Long, x As Long
    Sheets("Result").UsedRange.ClearContents
    Sheets("Data").Activate
    v = Range("B1", Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
    s = Me.TextBox1.Value
    If InStr(1, s, " ") > 0 Then
        cnt = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "*" & s & "*")
        ReDim arr(cnt, 6)
        For r = LBound(v) To UBound(v)
            If v(r, 4) Like "*" & s & "*" 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
    Else
        s = Me.TextBox1.Value
        cnt1 = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "* " & s & " *")
        cnt2 = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "* " & s & ".*")
        cnt = cnt1 + cnt2
        ReDim arr(cnt, 6)
        For r = LBound(v) To UBound(v)
            If InStr(1, " " & v(r, 4) & " ", " " & s & " ", vbTextCompare) > 0 Or InStr(1, " " & v(r, 4) & " ", " " & s & ".", vbTextCompare) 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
    End If
    Sheets("Result").Range("A1").Resize(cnt, 6).Value = arr
    Unload Me
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
Give this version a try.
VBA Code:
Private Sub cmdFIND_Click()
    Sheets("Result").UsedRange.ClearContents
    Application.ScreenUpdating = False
    Dim s As String, v As Variant, r As Long, c As Long, arr() As Variant, cnt As Long, cnt1 As Long, cnt2 As Long, x As Long
    Sheets("Result").UsedRange.ClearContents
    Sheets("Data").Activate
    v = Range("B1", Range("B" & Rows.Count).End(xlUp)).Resize(, 6).Value
    s = Me.TextBox1.Value
    If InStr(1, s, " ") > 0 Then
        cnt = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "*" & s & "*")
        ReDim arr(cnt, 6)
        For r = LBound(v) To UBound(v)
            If v(r, 4) Like "*" & s & "*" 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
    Else
        s = Me.TextBox1.Value
        cnt1 = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "* " & s & " *")
        cnt2 = Application.CountIf(Range("E1", Range("E" & Rows.Count).End(xlUp)), "* " & s & ".*")
        cnt = cnt1 + cnt2
        ReDim arr(cnt, 6)
        For r = LBound(v) To UBound(v)
            If InStr(1, " " & v(r, 4) & " ", " " & s & " ", vbTextCompare) > 0 Or InStr(1, " " & v(r, 4) & " ", " " & s & ".", vbTextCompare) 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
    End If
    Sheets("Result").Range("A1").Resize(cnt, 6).Value = arr
    Unload Me
    Application.ScreenUpdating = True
End Sub
Hi mumps - it works great. Results for east and east. = 139 occurrences. Exactly what it should give.
That should do it. Thanks so much for the time you spent on this. I look foward to the day I can write this enitre code
myself. I have more to learn about pattern searches combined with arrays.
cr
 
Upvote 0
Please note that when marking a post as the solution, please mark the actual thread that contains the solution (not your own post acknowledging that some other post is the solution).

You will notice that once you mark a post as the solution, it also appears at the very top under the original question, so anyone can easily see at quick glance the original question and the solution. So marking any post that does not actually contain the solution would kind of defeat the purpose of that.

I have gone ahead and change the posted solution for you.
 
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,100
Members
452,301
Latest member
QualityAssurance

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top