Sort hyperlinks in Excel with VBA macros

There is a known bug in Excel that makes errors in hyperlinks, if you sort the cells.

Fortunately there is a workaround using VBA macros, and on this page I show how.

Sorting by copying

I tried all kinds of devious tricks, but the sorted hyperlinks were like bewitched. It was like cutting the top off a leek on your kitchen table, and then see all the tops in the garden fall off at the same time!

At last I came up with a solution to the problem. It isn't elegant, but it is simple, and it works: Sorting by copying. The links will not suffer any damage, if you copy them, and that is the key.

For the example below to work, you must have a table with two columns starting in cell A1 on the first sheet. The cells with hyperlinks must be in column B. For instance the table can be alphabetical with company names in column A, and now you want to sort by personal names in the hyperlinks - whatever.

The first thing we do is to copy the table to the same range in Sheet2 (it can be anywhere). Then we add numbers 1, 2, 3 etc. to the cells in column C. That is the trick's first step!

The next step is to sort the new table including the row numbers in column C. We sort by the names in column B.

Because the row numbers were included in the sorting, they followed the cells in column B, and we can now use the old row numbers to identify the original "healthy" hyperlinks in the original table.

So now we just have to copy and overwrite the "sick" hyperlinks with the "healthy" and finally delete the row numbers in column C.

The example uses "CurrentRegion" to identify the table. CurrentRegion is handy, but it only works if the cells bordering your table or range are empty. If not, you must define your range some other way.

To test the code, highlight it with the mouse, copy (CTRL+C) and paste (CTRL+V) into a VBA module.

Sub SortHyperlinks()

Dim rTableOrig As Range
Dim rTableCopy As Range
Dim rCell As Range
Dim lCount As Long

On Error GoTo ErrorHandle

'Switch off screen updating
Application.ScreenUpdating = False

Worksheets(1).Activate

'We set the range rTableOrig = the table that we want to copy.
'For the example to work, the table must start in cell A1 on
'Sheet1, and it must have 2 columns with the hyperlinks in
'column B. The use of "CurrentRegion" requires that the table
'is bordered by empty cells.
Set rTableOrig = Range("A1").CurrentRegion

'The table is copied to the next sheet.
rTableOrig.Copy (Worksheets(2).Range("A1"))

'Before we proceed, we redefine rTableOrig to include the
'hyperlink cells only. We'll need the modified range later.
Set rTableOrig = Range(Range("B1"), Range("B1").End(xlDown))

Worksheets(2).Activate

'We set rTableCopy = the copy on Sheet2.
Set rTableCopy = Range("A1").CurrentRegion

'Now we insert row numbers in column C.
For lCount = 1 To rTableCopy.Rows.Count
   Range("C1").Offset(lCount - 1, 0).Value = lCount
Next

'We now select the whole table including column C,
'where we just put in row numbers.
Range("A1").CurrentRegion.Select

'Now the table is sorted with B1 as key.
'(If there are any compatibility problems from Excel 2000's sorting
'to Excel ????, try and replace the following with code generated
'by the macro recorder.)
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, _
Key2:=Range("A1"), Order2:=xlAscending, _
Key3:=Range("C1"), Order3:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

'rTableCopy is redefined to the sorted hyperlinks only.
Set rTableCopy = Range(Range("B1"), Range("B1").End(xlDown))

'Now we overwrite the sorted and "sick" hyperlinks with the
'healthy originals. To identify the healthy links, we use
'the sorted row numbers in column C.
With rTableOrig
   For Each rCell In rTableCopy
      .Item(rCell.Offset(0, 1).Value).Copy rCell
   Next
End With

'Delete the sorted row numbers.
rTableCopy.Offset(0, 1).Clear

BeforeExit:
Set rTableCopy = Nothing
Set rTableOrig = Nothing
Set rCell = Nothing
Application.ScreenUpdating = True

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure SortHyperlinks."
Resume BeforeExit
End Sub