Thread: read cell content and use with Hyperlinks.Add Cell

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

In ThisWorkBook:

Private Sub Workbook_BeforePrint(Cancel As Boolean) 
  For j = 4 To Sheets("DVD lijssie").[a4].End(xlDown).Row 
    With Sheets("DVD lijssie").Cells(j, 1) 
      If .Hyperlinks.Count = 0 And .Value <> "" Then 
         Sheets("DVD lijssie").Hyperlinks.Add Cells(j, 1), "http://www.imdb.com/find?s=all&q=" & .Value 
         With .Font 
           .Name = "Arial Narrow" 
           .Size = 8 
         End With 
      End If 
    End With 
  Next 
End Sub 


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
  For j = 4 To Sheets("DVD lijssie").[a4].End(xlDown).Row 
    With Sheets("DVD lijssie").Cells(j, 1) 
      If .Hyperlinks.Count = 0 And .Value <> "" Then 
         Sheets("DVD lijssie").Hyperlinks.Add Cells(j, 1), "http://www.imdb.com/find?s=all&q=" & .Value 
         With .Font 
           .Name = "Arial Narrow" 
           .Size = 8 
         End With 
      End If 
    End With 
  Next 
End Sub

No more on Worksheet_Change because to much to many times, I think I'll use another CheckBox to somehow call/start the function.