PDA

View Full Version : Delete all hyperlinks and the associated sheets



fatalcore
01-24-2012, 12:38 PM
Hi,
I have some hyperlinks in column L20 to L100.
What I want is a vba code than will not only delete the contents from L20 to L100 but also will delete the associated sheets with those hyperlink in that range.
The problem is that there are many cells in that column which are merged as such this simple code to delete the data is also not working.

Private Sub cmdRemoveHyperlinks_Click()
Application.ScreenUpdating = False
Range("L2o:l200").Select
Selection.ClearContents
Application.ScreenUpdating = True
End Sub
Thanks in advance.

mdmackillop
01-24-2012, 01:37 PM
Option Explicit

Sub ClearLinks()
Dim cel As Range
Dim hr As Range
Dim r, t, i As Long

'Initialise range
Set r = ActiveSheet.Hyperlinks(1).Range
'Find all hyperlinks
For i = 2 To ActiveSheet.Hyperlinks.Count
Set r = Union(r, ActiveSheet.Hyperlinks(i).Range)
Next

'Get desired links only
Set r = Intersect(r, Range("L20:L100"))

Application.DisplayAlerts = False
For Each cel In r
'Get sheet name
t = cel.Hyperlinks(1).SubAddress
'Delete sheet
Sheets(Split(t, "!")(0)).Delete
'Clear cell
cel.MergeArea.Clear
Next
Application.DisplayAlerts = False

End Sub

fatalcore
01-24-2012, 01:46 PM
Hi,
On running this code I received a Run time error 9 - subscript out of range
When I clicked debug,this line is highlighted in yellow. Any idea what is happening.
Set r = ActiveSheet.Hyperlinks(1).Range
Thanks in advance.

Kenneth Hobs
01-24-2012, 02:20 PM
If you will post a short example file, it is easier to help and test for all. Possibly, that sheet had no links to begin with. In that case, use:
On Error Resume Next
Howsoever, I like to avoid On Error routines when I can.

fatalcore
01-24-2012, 07:51 PM
Hi,
Here is the sheet i am talking about,
thanks in advance !

Kenneth Hobs
01-25-2012, 09:00 AM
This is a case where examples help. A hyperlink by formula is not the same as a hyperlink for a range object.

Right click your "before" sheet, View Code, and paste and replace your button code or just paste the routine and change the button's call to the Sub.

Private Sub CommandButton1_Click()
'Call ClearLinks
ClearFormulaHyperlinksAndSheets
End Sub

Sub ClearFormulaHyperlinksAndSheets()
Dim c As Range, s As String

SpeedOn
On Error GoTo EndSub

For Each c In ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
s = c.formula
If InStr(s, "HYPERLINK") <> 2 Then GoTo NextC
s = Mid(s, InStr(s, "'") + 1, InStrRev(s, "'") - InStr(s, "'") - 1)
If WorkSheetExists(s) Then Worksheets(s).Delete
c.formula = Empty
NextC:
Next c

EndSub:
SpeedOff
End Sub

Notice that I used by Speed routines. You can get them in a Module at: http://vbaexpress.com/kb/getarticle.php?kb_id=1035

In the Speed module or another, paste this:
Function WorkSheetExists(sWorkSheet As String, Optional sWorkbook As String = "") As Boolean
Dim ws As Worksheet, wb As Workbook
On Error GoTo notExists
If sWorkbook = "" Then
Set wb = ActiveWorkbook
Else
Set wb = Workbooks(sWorkbook)
End If
Set ws = wb.Worksheets(sWorkSheet)
WorkSheetExists = True
Exit Function
notExists:
WorkSheetExists = False
End Function

fatalcore
01-25-2012, 09:33 AM
Thanks Kenneth, That is absolutely brilliant.

Kenneth, I am also struggling in two things with this same sheet. Instead of creating a new thread I am posting in the same link as it deals with the same file.

1. I am pulling data from other sheet to column K.So I want a separate vba code that will convert the data on column K to values.

2.I am using a code to generate number of repetation. The problem is when I am running the code i am getting strange errors. Like the number of repetations is inserted in sheet "Face". Then I am pulling the data to "before" sheet.
and then running the code.I am highlighting the cells where the errors are cropping.

3.I also want a code that will delete the entire duplicate row based on Column F also the linked pages under column L if any.

Thanks for everything mate.Godbless!