+ Reply to Thread
Results 1 to 2 of 2

read cell content and use with Hyperlinks.Add Cell

Hybrid View

  1. #1
    Registered User
    Join Date
    09-03-2007
    Posts
    6

    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

  2. #2
    Registered User
    Join Date
    09-03-2007
    Posts
    6

    Thumbs up SOLVED (WorkAround)

    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.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1