Finding multiple cell addresses

[danielpalfrey]

Ok guys, I am going to try and explain this clearly this time.
I have a spread sheet, in column A there is a list of words. There is a button on the spread sheet, we will call the button tst.
The layout for column A is a word, then some cells containing info then another word. The words that are important are one two three four five six seven eight nine ten end

Upon clicking the tst button I need the cells containting the info to be hidden, but the numbers as above need to stay showing.

As an example when I click tst button A1 contains "one" then A2:A5 is just information so 2:5 hides A6 contains "two" so the stays showing but then the cells below that with just info hide until the cell containing "three"

I have been able to get this on a double click even for each number but have been asked to make a button to do it all at once.

Many thanks

 

[James006]

Hello,

Why don't you post your Double-Click Event macro ...

since what you are after is just a modification of your existing code ...

 

[danielpalfrey]

Dim hre As StringDim WrdArray() As String
Dim FindText As String
Dim Onecell As Range
Dim hr As Label
hre = ActiveCell.Row + 1
lst = "one/two/three/four/five/six/seven/eight/nine/ten"
  
If Not Intersect(Target, Range("A1:A5000")) Is Nothing Then
  For Each Onecell In Range("A" & hre & ":A50")
WrdArray() = Split(lst, "/")
For i = LBound(WrdArray) To UBound(WrdArray)


    If InStr(UCase(Onecell.Text), UCase(WrdArray(i))) > 0 Then
            ListText = Onecell.Row - 1
FindText = WrdArray(i)
GoTo hr
         End If
        Next i
        Next Onecell
        
hr:
Rows(hre & ":" & ListText).Hidden = Not Rows(hre & ":" & ListText).Hidden

 

[James006]

Do not know if you have posted your macro in its entirety ...

Your code allows to hide rows which are located in between the ten items listed in your String lst ...

Is your objective to hide all the rows from a1 to A5000 which do not contain your items in lst ...?

 

[James006]

Hello again,

You could test the following macros ...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
' To Hide Rows
Dim Onecell As Range
Dim lst As Variant
Dim Rng As Range
Dim res As Variant
Set Rng = Range("A1:A5000")
lst = Array("one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten")
If Intersect(Target, Rng) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    For Each Onecell In Range("A1:A" & Rng.Count)
        res = Application.Match(Onecell.Value, lst, 0)
        If IsError(res) Then Onecell.EntireRow.Hidden = True
    Next Onecell
Cancel = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
' To Unhide Rows
  Cells.EntireRow.Hidden = False
  Cancel = True
End Sub

Hope this will help

 

[danielpalfrey]

Do not know if you have posted your macro in its entirety ...

Your code allows to hide rows which are located in between the ten items listed in your String lst ...

Is your objective to hide all the rows from a1 to A5000 which do not contain your items in lst ...?

Yes that is correct. I will double check the code as I copied and pasted from my phone and we all know that doesn't help.

 

[James006]

Thanks ...

Once you have tested the macros posted in message # 5 ...

Let me know if it is in line with your expectations ... or not ...

 

[danielpalfrey]

I will test the code in a moment but no, my code looked incomplete.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

hre = ActiveCell.Row + 1
lst = "one/two/three/four/five/six/seven/eight/nine/ten/end"


If Not Intersect(Target, Range("A1:A5000")) Is Nothing Then
For Each Onecell In Range("A" & hre & ":A5000")
WrdArray() = Split(lst, "/")
For i = LBound(WrdArray) To UBound(WrdArray)


If InStr(UCase(Onecell.Text), UCase(WrdArray(i))) > 0 Then
ListText = Onecell.Row - 1
FindText = WrdArray(i)


GoTo hr
End If


        Next i
        Next Onecell
        End If
hr:
Rows(hre & ":" & ListText).Hidden = Not Rows(hre & ":" & ListText).Hidden


End Sub

 

[James006]

Forgot to mention ...

The First macro DoubleClick should hide all the Rows ...

and to make things easier the second macro RightClick should Unhide all the Rows ...

 

[danielpalfrey]

Thanks for the code, I have it working perfectly now, had to make a few mods to get it to work on button click.

Private Sub tst_Click()

Dim Cancel As Boolean
Dim Target As Range
Dim Onecell As Range
Dim lst As Variant
Dim Rng As Range
Dim res As Variant


Set Rng = Range("A1:A5000")
lst = Array("one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten")


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    For Each Onecell In Range("A1:A" & Rng.Count)
        res = Application.Match(Onecell.Value, lst, 0)
        If IsError(res) Then Onecell.EntireRow.Hidden = True
    Next Onecell
Cancel = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub