searching for cell location

[danielpalfrey]

Ok, this is a little unusual, I need to find cells that contain one of multiple words.
The plan is, double click a word in column A, upon clicking this word a list will be searched to find out if the word appears in the list, if it does appear in the list then the hidden rows below need to be unhidden untill the next recognised word in the list. I have it working somewhat, but when running the debug it doesnt do as I would expect it to in terms of used values, even though the end result works.

My code is:

Dim hre As StringDim WrdArray() As String
Dim FindText As String
Dim Onecell As Range
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 & ":A46")
WrdArray() = Split(lst, "/")
    If InStr(Onecell.Text, FindText) > 0 Then
            ListText = Onecell.Row - 1
FindText = WrdArray(i)
        End If
Next Onecell


Rows(hre & ":" & ListText).Hidden = Not Rows(hre & ":" & ListText).Hidden


If MsgBox(Prompt:="Open address label?", Buttons:=vbYesNo + vbQuestion, Title:="Hyperlink Activated") = vbYes Then
Dim objWord As Object
Dim fl As String
fl = ActiveCell.Text
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Open "C:\Users\700warranty\Desktop\DOCUMENTS\Address Labels\" & fl & ".docx"

Now, I have no idea how this code is working, I am hoping someone could let me know where I went wrong.

Originally, when I made this I programmed each sup with its own bar of code to the next sup, this was not practical as I could not add to the list easily and wanted to limit the amount of code needed to add a new sup

I have also added a simple button to hide all cells not containing the words in lst I am having some problems getting this working though, I am sure however that if someone could correct what I have done above I should be able to then get the code working to hide them,

Many Many thanks

Dan

 

[danielpalfrey]

Ok, so below is a clipping of the original code, this code worked for what I needed but never made it easy for what I wanted to do (in terms of adding suppliers to the list(sups))

Dim sup1 As String
Dim sup2 As String
Dim sup3 As String
Dim sup4 As String
Dim sup5 As String
Dim sup6 As String
Dim sup7 As String
Dim sup8 As String
Dim sup9 As String
Dim sup10 As String
Dim sup11 As String
Dim sup12 As String
Dim sup13 As String
Dim sup14 As String
Dim sup15 As String
Dim sup16 As String
Dim sup17 As String
Dim sup18 As String
Dim sup19 As String
Dim sup20 As String
Dim sup21 As String
Dim sup22 As String
Dim sup23 As String
Dim sup24 As String
Dim sup25 As String
Dim sup26 As String
Dim sup27 As String
Dim sup28 As String
Dim sup29 As String
Dim sup30 As String
Dim sup31 As String
Dim sup32 As String
Dim sup33 As String
Dim sup34 As String
Dim sup35 As String
Dim sup36 As String
Dim sup37 As String
Dim sup38 As String
Dim sup39 As String
Dim sup40 As String
Dim sup41 As String
Dim sup42 As String
Dim sup43 As String
Dim sup44 As String
Dim sup45 As String
Dim sup46 As String
Dim sup47 As String
Dim sup48 As String
Dim sup49 As String
Dim sup50 As String


sup1 = "Airtex"
sup2 = "Arnott"
sup3 = "BGA"
sup4 = "BM Cats"
sup5 = "Bosch"
sup6 = "BTN"
sup7 = "Bremi"
sup8 = "Bugiad"
sup9 = "Carwood"
sup10 = "Carwood Turbo"
sup11 = "Continental"
sup12 = "Contitech"
sup13 = "Corteco"
sup14 = "Dayco"
sup15 = "Delphi"
sup16 = "Delphi turbo"
sup17 = "Denso"
sup18 = "EEC"
sup19 = "Elring"
sup20 = "ERA"
sup21 = "Exedy"
sup22 = "FAI"
sup23 = "Facet"
sup24 = "FAE"
sup25 = "First line"
sup26 = "FTE"
sup27 = "GKN"
sup28 = "Hamtune"
sup29 = "Hans pries"
sup30 = "Hella"
sup31 = "Huco"
sup32 = "Hutchinson"
sup33 = "Jopex"
sup34 = "Lesjofors"
sup35 = "Metelli spa"
sup36 = "Meyle"
sup37 = "MSI"
sup38 = "NGK"
sup39 = "Nissens"
sup40 = "NRF"
sup41 = "Sachs"
sup42 = "Shaftec"
sup43 = "SKF"
sup44 = "SNR"
sup45 = "Standard"
sup46 = "Teamec"
sup47 = "Turbo active"
sup48 = "Werner"
sup49 = "TP Engineering"
sup50 = "AVA"


a = Range("A1:A5000").Find(sup1, Range("A1"), xlValues, xlWhole, xlNext).Row
b = Range("A1:A5000").Find(sup2, Range("A1"), xlValues, xlWhole, xlNext).Row
c = Range("A1:A5000").Find(sup3, Range("A1"), xlValues, xlWhole, xlNext).Row
d = Range("A1:A5000").Find(sup4, Range("A1"), xlValues, xlWhole, xlNext).Row
e = Range("A1:A5000").Find(sup5, Range("A1"), xlValues, xlWhole, xlNext).Row
f = Range("A1:A5000").Find(sup6, Range("A1"), xlValues, xlWhole, xlNext).Row
g = Range("A1:A5000").Find(sup7, Range("A1"), xlValues, xlWhole, xlNext).Row
h = Range("A1:A5000").Find(sup8, Range("A1"), xlValues, xlWhole, xlNext).Row
i = Range("A1:A5000").Find(sup9, Range("A1"), xlValues, xlWhole, xlNext).Row
j = Range("A1:A5000").Find(sup10, Range("A1"), xlValues, xlWhole, xlNext).Row
k = Range("A1:A5000").Find(sup11, Range("A1"), xlValues, xlWhole, xlNext).Row
l = Range("A1:A5000").Find(sup12, Range("A1"), xlValues, xlWhole, xlNext).Row
m = Range("A1:A5000").Find(sup13, Range("A1"), xlValues, xlWhole, xlNext).Row
n = Range("A1:A5000").Find(sup14, Range("A1"), xlValues, xlWhole, xlNext).Row
o = Range("A1:A5000").Find(sup15, Range("A1"), xlValues, xlWhole, xlNext).Row
p = Range("A1:A5000").Find(sup16, Range("A1"), xlValues, xlWhole, xlNext).Row
q = Range("A1:A5000").Find(sup17, Range("A1"), xlValues, xlWhole, xlNext).Row
r = Range("A1:A5000").Find(sup18, Range("A1"), xlValues, xlWhole, xlNext).Row
s = Range("A1:A5000").Find(sup19, Range("A1"), xlValues, xlWhole, xlNext).Row
t = Range("A1:A5000").Find(sup20, Range("A1"), xlValues, xlWhole, xlNext).Row
u = Range("A1:A5000").Find(sup21, Range("A1"), xlValues, xlWhole, xlNext).Row
v = Range("A1:A5000").Find(sup22, Range("A1"), xlValues, xlWhole, xlNext).Row
w = Range("A1:A5000").Find(sup23, Range("A1"), xlValues, xlWhole, xlNext).Row
x = Range("A1:A5000").Find(sup24, Range("A1"), xlValues, xlWhole, xlNext).Row
y = Range("A1:A5000").Find(sup25, Range("A1"), xlValues, xlWhole, xlNext).Row
Z = Range("A1:A5000").Find(sup26, Range("A1"), xlValues, xlWhole, xlNext).Row
aa = Range("A1:A5000").Find(sup27, Range("A1"), xlValues, xlWhole, xlNext).Row
ab = Range("A1:A5000").Find(sup28, Range("A1"), xlValues, xlWhole, xlNext).Row
ac = Range("A1:A5000").Find(sup29, Range("A1"), xlValues, xlWhole, xlNext).Row
ad = Range("A1:A5000").Find(sup30, Range("A1"), xlValues, xlWhole, xlNext).Row
ae = Range("A1:A5000").Find(sup31, Range("A1"), xlValues, xlWhole, xlNext).Row
af = Range("A1:A5000").Find(sup32, Range("A1"), xlValues, xlWhole, xlNext).Row
ag = Range("A1:A5000").Find(sup33, Range("A1"), xlValues, xlWhole, xlNext).Row
ah = Range("A1:A5000").Find(sup34, Range("A1"), xlValues, xlWhole, xlNext).Row
ai = Range("A1:A5000").Find(sup35, Range("A1"), xlValues, xlWhole, xlNext).Row
aj = Range("A1:A5000").Find(sup36, Range("A1"), xlValues, xlWhole, xlNext).Row
ak = Range("A1:A5000").Find(sup37, Range("A1"), xlValues, xlWhole, xlNext).Row
al = Range("A1:A5000").Find(sup38, Range("A1"), xlValues, xlWhole, xlNext).Row
am = Range("A1:A5000").Find(sup39, Range("A1"), xlValues, xlWhole, xlNext).Row
an = Range("A1:A5000").Find(sup40, Range("A1"), xlValues, xlWhole, xlNext).Row
ao = Range("A1:A5000").Find(sup41, Range("A1"), xlValues, xlWhole, xlNext).Row
ap = Range("A1:A5000").Find(sup42, Range("A1"), xlValues, xlWhole, xlNext).Row
aq = Range("A1:A5000").Find(sup43, Range("A1"), xlValues, xlWhole, xlNext).Row
ar = Range("A1:A5000").Find(sup44, Range("A1"), xlValues, xlWhole, xlNext).Row
at = Range("A1:A5000").Find(sup45, Range("A1"), xlValues, xlWhole, xlNext).Row
au = Range("A1:A5000").Find(sup46, Range("A1"), xlValues, xlWhole, xlNext).Row
ax = Range("A1:A5000").Find(sup49, Range("A1"), xlValues, xlWhole, xlNext).Row
av = Range("A1:A5000").Find(sup47, Range("A1"), xlValues, xlWhole, xlNext).Row
aw = Range("A1:A5000").Find(sup48, Range("A1"), xlValues, xlWhole, xlNext).Row
ay = Range("A1:A5000").Find(sup50, Range("A1"), xlValues, xlWhole, xlNext).Row


If Not Intersect(Target, Range("A" & a)) Is Nothing Then
Rows(a + 1 & (":") & ay - 1).Hidden = Not Rows(a + 1 & (":") & ay - 1).Hidden
Dim name1 As String
name1 = ThisWorkbook.Sheets("Sheet1").Range("A" & a).Text


If MsgBox(Prompt:="Open address label?", Buttons:=vbYesNo + vbQuestion, Title:="Hyperlink Activated") = vbYes Then
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Open ("C:\Users\700warranty\Desktop\DOCUMENTS\Address Labels\") & name1 & (".docx ")
End If
End If

The last block of code was repeated over and over and over time and again for each supplier.
What I want to do is simplify this So I just add a new supplier (sup) to the list and that is it.

The code posted first is doing the job, but the search term used from my list is always "one" instead of actually searching the list with the word array, which is the problem because I need to use that word for something afterwords (like opening the appropriate word doc)

Many thanks for any help.

 

[My Aswer Is This]

You surely do not need all this code just to hide some rows.

You said:

Now, I have no idea how this code is working

So I must assume you did not write this code.

So please just tell us what your wanting to do.

We need to know where to search for certain words and where is the list of these certain words.

Like search column B for all the words in Column G Rows 1 to 20

And when you double click on a cell in column A is that the word in that cell what we are search for?

_{^{<strike>
</strike>}}​

So if you double click on George hide all rows with George in Column A

 

[danielpalfrey]

You are right, the code in the first post is code I have searched for and put together, not entirely understanding it. Double click event happens on column A Upon double click the code needs to look into string values defined under lst as string. Using / as the seperator. The idea is that when you double click, the code will search down the column looking for the next cell containing one of the words from string, when it find that word it will need to unhide or hide (depending on weather the columns are hidden or not already) down to that cell

 

[My Aswer Is This]

This still does not help me.

You said:

needs to look into string values defined under lst as string

I do not understand that.

You said:

double click, the code will search down the column looking for the next cell containing one of the words from string

Search down what column?


Give me a example

Are you saying if you double click on:

Dad/Mom/Bob/George/Stanley/Julia

I need to search for Dad and Mom and Bob and George and Stanley and Julia

​

​

 

[danielpalfrey]

Ok, I got it working kind of earlier but it ended up looping around after finding the text which was annoying me. I have now come up with a fix which I know will be frowned on but it worked and I did not see another way around it....

Here is the code for anyone interested.

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