read cell content and use with Hyperlinks.Add Cell etc. etc.
I use the code below to read Cell-Content in Column:A and use that to generate a hyperlink with the content off the/a cell.
The auto-hyperlink works great BUT there seems to be a small flaw in the vba code.
If I delete the content of a cell (which allready has been auto-hyperlinked with the vba code) then it replaces the just emptied content of the cell with the url (text) => http://www.imdb.com/find?s=all&q= instead of deleting/clear the cell content.
It seems to me that this line is the problem, at least in my opinion:
If Cell.Hyperlinks.Count = 0 Then... etc.
When I look at it, it seems obvious that when I delete the content of a cell (with delete) that the code will drop the http://www.imdb.com/find?s=all&q= line in the cell instead.
Because a completely emptied cell also is/becomes equal to 0, how could I overcome this?
Could anybody help me out please? I guess I need to define somehow that when I delete the content of a cell or when cell content is completely empty it should be ignored by the auto-hyperlink code.
Used in this vba-code (in WorkSheet):
' Auto-Hyperlink on Column:A & Auto-SORT !!! !!! !!! !!! ! '
Private Sub Worksheet_Change(ByVal Target As Range)
If CheckBox1.Value = True Then
' (START) Auto-HYPERLINK by DEFAULT !!! !!! !!! !!! !!! !!! ! '
Dim Sh As Worksheet
Dim rng As Range
' only look at single cell changes
Dim Cell As Range
Set Sh = Worksheets("DVD Lijssie")
Set rng = Sh.Range("A4:A" & Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row)
' only look at that range
For Each Cell In rng
If Cell.Hyperlinks.Count = 0 Then
Sh.Hyperlinks.Add Cell, "http://www.imdb.com/find?s=all&q=" & Cell.Value
With Cell.Font
.Name = "Arial Narrow"
.Size = 8
End With
End If
Next Cell
' (END) Auto-HYPERLINK by DEFAULT !!! !!! !!! !!! !!! !!! !! '
' (START) Auto-SORT on Check(Box1) !!! !!! !!! !!! !!! !!! ! '
If Target.Count > 1 Then Exit Sub
Set rng = rng.Resize(, 7)
' The Resize property takes 2 arguments, RowSize and ColumnSize.
' If an argument is omitted, the number remains the same.
' So: Set rng = rng.Resize(, 7) => expands the existing rng to 7 columns,
' retaining the existing number of rows.
If Intersect(Target, rng) Is Nothing Then Exit Sub
rng.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
' (END) Auto-SORT on Check(Box1) !!! !!! !!! !!! !!! !!! !!! '
Else
CheckBox1.Value = False
' DO NOTHING AT ALL WHEN FALSE/UNCHECKED/DISABLED
End If
End Sub
With kind regards, Tim
Bookmarks