I am using the below code to modify TextToDisplay
of hyperlinks for a column of 10k cells.
It works, but the code takes about 10 seconds to finish (on high end PC).
I am seeking for a faster method to fulfil this task.
I tried to put all the hyperlinks on an array ,but I got the below error on code
Dim rng As Range
Set rng = ws.Range("N2", ws.Cells(Rows.Count, "N").End(xlUp))
Dim arr
arr = rng.Hyperlinks ‘Run-time error 450: Wrong number of arguments or invalid property assignment
This the working code, but it is slow.
I also tried turn off screenupdating
, but it make no difference.
In advance, grateful for any helpful comments and answers.
Option Explicit
Option Compare Text
Sub Replace_Hyperlinks_TextToDisplay_Q()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim LastRow As Long
LastRow = ws.Range("O" & Rows.Count).End(xlUp).Row
Const str1 As String = "http://xxxxx/"
Const str2 As String = "\"
Dim i As Long
For i = 2 To LastRow
If ws.Range("O" & i).Hyperlinks.Count > 0 Then
ws.Range("O" & i).Hyperlinks(1).TextToDisplay = Replace(Range("O" & i), str1, "")
ws.Range("O" & i).Hyperlinks(1).TextToDisplay = Replace(Range("O" & i), str2, " - " & vbLf)
ws.Range("O" & i).Hyperlinks(1).TextToDisplay = UCase(Left(ws.Range("O" & i).Hyperlinks(1).TextToDisplay, 1)) _
Mid(ws.Range("O" & i).Hyperlinks(1).TextToDisplay, 2, _
Len(ws.Range("O" & i).Hyperlinks(1).TextToDisplay))
End If
Next i
End Sub
CodePudding user response:
We can replace the Range.TextToDisplay
value using an array just like any other value. I haven't tested this on a large range but it should be significantly faster than iterating over the cells.
Sub Replace_Hyperlinks_TextToDisplay_Q2()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Const str1 As String = "http://xxxxx/"
Const str2 As String = "\"
Dim Target As Range
Dim Data As Variant
With ActiveSheet
Set Target = .Range("O1", .Cells(.Rows.Count, "O").End(xlUp))
End With
Data = Target.Value
Dim r As Long
For r = 1 To UBound(Data)
Data(r, 1) = Replace(Data(r, 1), str1, "")
Data(r, 1) = Replace(Data(r, 1), str2, " - " & vbLf)
Data(r, 1) = UCase(Left(Data(r, 1), 1)) & Mid(Data(r, 1), 2, Len(Data(r, 1)))
Next
Target.Value = Data
Application.Calculation = xlCalculationAutomatic
End Sub