Assistance with some VBA code please

[Pauljj]

I have this code below which is basically searching for Hyperlinks, if it finds them, it shows how many are there and then deletes them. Problem is, as it needs to list them, I noticed it before I put in the

Range("O1").Select

That it would list them in whatever cell was last activated by the user, so I added the above so it would always list them in O1. The only problem with this and its a small one, is that the spreadsheet moves over to O1 before running the code and moving back to A1. Could it not just list them in O1 without me needing to see the screen move to O1...does that make sense ????

Anyhow this is the code

Private Sub Workbook_Open()

Range("O1").Select

Application.ScreenUpdating = False

Dim hypLnk As Hyperlink
Dim myCnt&

'The sheet that gets the found list!
Sheets("UK").Select
myCnt = 1

'The sheet to search!
For Each hypLnk In Worksheets("UK").Hyperlinks

'Activate to search a range [column]!
'If hypLnk.Range.Column = 1 Then
Selection.Cells(myCnt, 1) = myCnt
Selection.Cells(myCnt, 2) = hypLnk.Range.Address(RowAbsolute:=False, ColumnAbsolute:=False)
If hypLnk.Address = "" Then
Selection.Cells(myCnt, 3) = "Sheet Range/Cell Link!"
Else
Selection.Cells(myCnt, 3) = hypLnk.Address
End If
myCnt = myCnt + 1
'End If

Next hypLnk

'Indicate when done!
MsgBox "Done searching for links!" & vbLf & "Found: " & myCnt - 1 & " hyperlinks!"

For Each ws In ThisWorkbook.Worksheets
If ws.Hyperlinks.Count > 0 Then
Columns("A:L").Select
Range("A1").Activate
Selection.Copy
Range("AA1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ws.Hyperlinks.Delete
Columns("AA:AL").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Columns("AA:AL").Select
Application.CutCopyMode = False
Selection.ClearFormats
End If
Next ws
Range("A1").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True

Range("A1").Select

End Sub

 

[Lewiy]

The reason it jumps around is because of the “Select” commands. These will ultimately slow down your code. I’ve cleaned up the code a little trying not to mess with it too much. As I have no data to test on, I don’t know if it will still do what you want, but give it a try:

Private Sub Workbook_Open()

Application.ScreenUpdating = False

Dim hypLnk As Hyperlink
Dim myCnt&

'The sheet that gets the found list!
Sheets("UK").Select
myCnt = 1

'The sheet to search!
For Each hypLnk In Worksheets("UK").Hyperlinks

'Activate to search a range [column]!
'If hypLnk.Range.Column = 1 Then
    With Range("O1")
        .Cells(myCnt, 1) = myCnt
        .Cells(myCnt, 2) = hypLnk.Range.Address(RowAbsolute:=False, ColumnAbsolute:=False)
        If hypLnk.Address = "" Then
            .Cells(myCnt, 3) = "Sheet Range/Cell Link!"
            Else
                .Cells(myCnt, 3) = hypLnk.Address
        End If
        myCnt = myCnt + 1
    End With

Next hypLnk

'Indicate when done!
MsgBox "Done searching for links!" & vbLf & "Found: " & myCnt - 1 & " hyperlinks!"

For Each ws In ThisWorkbook.Worksheets
    If ws.Hyperlinks.Count > 0 Then
        Columns("A:L").Copy
        Range("AA1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        ws.Hyperlinks.Delete
        Columns("AA:AL").Copy
        Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Columns("AA:AL").ClearFormats
    End If
Next ws
Range("A1").Select
End Sub

 

[VoG]

I'm not quite sure what you are trying to do but if it is simply counting hyperlinks then deleting them, why not:

Sub hl()
MsgBox ActiveSheet.Hyperlinks.Count
ActiveSheet.Hyperlinks.Delete
End Sub

 

[Pauljj]

Lewiy, thanks very much, your tidied version of my code works an absolute treat.

Many thanks