I have this macro which searching for 3 words in same row and if it find
some then display them in listbox. some rows contain hyperlink and i would
like to keep this function. please help.
some er hyperlinks on internet and some on my c:drive.

Private Sub CommandButton1_Click()

Dim sOne, sOneItem

With UserForm1
'******
If .OptionButton1 Then sOne = Array("Horse")
If .OptionButton2 Then sOne = Array("Pig")
If .OptionButton5 Then sOne = Array("Horse", "Pig")
'******
If .OptionButton3 Then
sTwo = "Dansk"
Else
sTwo = "Engelsk"
End If
sThree = .TextBox1.Text
End With

'******
For Each sOneItem In sOne
'******
'MsgBox sOneItem
With Worksheets(1).Cells
Set c = .Find(sOneItem, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If Application.CountIf(c.EntireRow, "*" & sTwo & "*") And _
Application.CountIf(c.EntireRow, "*" & sThree & "*")
Then
UserForm1.ListBox1.AddItem
UserForm1.ListBox1.List( _
UserForm1.ListBox1.ListCount - 1, 0) _
= c.Offset(0, -6).Value
UserForm1.ListBox1.List( _
UserForm1.ListBox1.ListCount - 1, 1) _
= c.Offset(0, -3).Value
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
'******
Next
'******
End Sub

I don't think you're gonna get a hyperlink to work in your listbox.

Maybe you can keep track of which entries in the listbox list contain
hyperlinks. Then if one of those is selected, you can use:

Thisworkbook.followhyperlinks xxxx

to mimic that behavior.

Alen32 wrote:

I have this macro which searching for 3 words in same row and if it find
some then display them in listbox. some rows contain hyperlink and i would
like to keep this function. please help.
some er hyperlinks on internet and some on my c:drive.

Private Sub CommandButton1_Click()

Dim sOne, sOneItem

With UserForm1
'******
If .OptionButton1 Then sOne = Array("Horse")
If .OptionButton2 Then sOne = Array("Pig")
If .OptionButton5 Then sOne = Array("Horse", "Pig")
'******
If .OptionButton3 Then
sTwo = "Dansk"
Else
sTwo = "Engelsk"
End If
sThree = .TextBox1.Text
End With

'******
For Each sOneItem In sOne
'******
'MsgBox sOneItem
With Worksheets(1).Cells
Set c = .Find(sOneItem, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If Application.CountIf(c.EntireRow, "*" & sTwo & "*") And _
Application.CountIf(c.EntireRow, "*" & sThree & "*")
Then
UserForm1.ListBox1.AddItem
UserForm1.ListBox1.List( _
UserForm1.ListBox1.ListCount - 1, 0) _
= c.Offset(0, -6).Value
UserForm1.ListBox1.List( _
UserForm1.ListBox1.ListCount - 1, 1) _
= c.Offset(0, -3).Value
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
'******
Next
'******
End Sub

--

Dave Peterson

where to insert your sugestion Thisworkbook.followhyperlinks xxxx

Maybe in the listbox_change procedure?

Or if you have a button that says "ok", put it in there.



Alen32 wrote:

where to insert your sugestion Thisworkbook.followhyperlinks xxxx

--

Dave Peterson

And the xxxx would be the link that you kept track of -- it's not really xxxx.

Alen32 wrote:

where to insert your sugestion Thisworkbook.followhyperlinks xxxx

--

Dave Peterson

I did try but doesn't work

Maybe this will get you further along.

I put a listbox and two commandbuttons on a userform.

This is the code I used under the userform:

Option Explicit
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub CommandButton2_Click()
Dim myURL As String

If Me.ListBox1.ListIndex -1 Then
'something's selected
myURL = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
End If

If myURL = "" Then
'do nothing
Else
ThisWorkbook.FollowHyperlink Address:=myURL
End If

End Sub

Private Sub UserForm_Initialize()
Dim myCell As Range
Dim myRng As Range

With Me.ListBox1
.ColumnCount = 2
.ColumnWidths = "20;0"
.RowSource = ""
.Clear

With Worksheets("sheet1")
Set myRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In myRng.Cells
.AddItem myCell.Value
If myCell.Hyperlinks.Count 0 Then
.List(.ListCount - 1, 1) = myCell.Hyperlinks(1).Address
Else
.List(.ListCount - 1, 1) = ""
End If
Next myCell

End With

Unload Me

End Sub


Alen32 wrote:

I did try but doesn't work

--

Dave Peterson