ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Macro to randomize and delete accessed hyperlinks (https://www.excelbanter.com/excel-programming/340440-macro-randomize-delete-accessed-hyperlinks.html)

twinklejmj[_3_]

Macro to randomize and delete accessed hyperlinks
 

Hi

I am struggling for coding a macro. Can anybody please help?

I have 8 hyperlinks in a column in a work sheet. Taking input from the
user, this set (8 hyperlinks) has to be copied n times (n - the user
input ). Then each set (contaning 8 limks) has to be randomized
locally (within each set). So there will be a total of n times
randomization. Then as the user accesses the hyperlink, that specific
hyperlink has to be deleted from the worksheet so that the user is not
able to access that hyperlink further. This is to be applicable to all
8*n hyperlinks.

Thanks a lot.

Twinkle


--
twinklejmj
------------------------------------------------------------------------
twinklejmj's Profile: http://www.excelforum.com/member.php...o&userid=27085
View this thread: http://www.excelforum.com/showthread...hreadid=468708


Dave Peterson

Macro to randomize and delete accessed hyperlinks
 
So the original 8 links remain untouched.

Put this code in a general module.

Option Explicit
Sub testme()

Dim HowManyTimesToRepeat As Long
Dim RngWithHyperlinks As Range
Dim ColWithHyperlinks As Long
Dim RowsWithHyperlinks As Long
Dim newCol As Range
Dim wks As Worksheet
Dim iCtr As Long
Dim destRow As Long
Dim RngToSort As Range

Set wks = Worksheets("sheet1")

HowManyTimesToRepeat _
= CLng(Application.InputBox(Prompt:="How many times?", _
Default:=2, Type:=1))

If HowManyTimesToRepeat < 1 Then
'we're done
Exit Sub
End If

If HowManyTimesToRepeat 100 Then
MsgBox "Get serious!"
Exit Sub
End If

With wks
Set RngWithHyperlinks = .Range("a1:A8")
RowsWithHyperlinks = RngWithHyperlinks.Rows.Count
ColWithHyperlinks = RngWithHyperlinks.Column

RngWithHyperlinks.Offset(0, 1).EntireColumn.Insert

With RngWithHyperlinks
destRow = .Cells(.Cells.Count).Row + 1
End With
For iCtr = 1 To HowManyTimesToRepeat
RngWithHyperlinks.Copy _
Destination:=.Cells(destRow, ColWithHyperlinks)
With .Cells(destRow, ColWithHyperlinks + 1) _
.Resize(RowsWithHyperlinks, 1)
.Formula = "=" & iCtr & "+rand()"
.Value = .Value
End With
destRow = destRow + RowsWithHyperlinks
Next iCtr

'sort by that extra column

Set RngToSort _
= .Range(.Cells(1, ColWithHyperlinks + 1).End(xlDown), _
.Cells(.Rows.Count, ColWithHyperlinks + 1).End(xlUp))

RngToSort.Offset(0, -1).Name = "'" & wks.Name & "'!LinkRng"


With RngToSort.Offset(0, -1).Resize(, 2)
.Cells.Sort key1:=.Columns(2), order1:=xlAscending, _
header:=xlNo
End With

.Cells(1, ColWithHyperlinks + 1).EntireColumn.Delete

End With
End Sub

This adds an extra column to the right. It uses that to sort the links. Then
it adds a worksheet level name to the list of repeated/randomized links.

Then place this under the worksheet that has those hyperlinks:

Option Explicit
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

Dim TestRng As Range

With Target.Parent
Set TestRng = Nothing
On Error Resume Next
Set TestRng = Me.Range("LinkRng")
On Error GoTo 0

If TestRng Is Nothing Then
'do nothing
Else
If Intersect(.Cells, TestRng) Is Nothing Then
'do nothing
Else
.Hyperlinks.Delete
.ClearContents '??? clear the cell, too???
End If
End If
End With

End Sub

Can I ask what this is gonna be used for?

It seems pretty darn unusual.


twinklejmj wrote:

Hi

I am struggling for coding a macro. Can anybody please help?

I have 8 hyperlinks in a column in a work sheet. Taking input from the
user, this set (8 hyperlinks) has to be copied n times (n - the user
input ). Then each set (contaning 8 limks) has to be randomized
locally (within each set). So there will be a total of n times
randomization. Then as the user accesses the hyperlink, that specific
hyperlink has to be deleted from the worksheet so that the user is not
able to access that hyperlink further. This is to be applicable to all
8*n hyperlinks.

Thanks a lot.

Twinkle

--
twinklejmj
------------------------------------------------------------------------
twinklejmj's Profile: http://www.excelforum.com/member.php...o&userid=27085
View this thread: http://www.excelforum.com/showthread...hreadid=468708


--

Dave Peterson

twinklejmj[_5_]

Macro to randomize and delete accessed hyperlinks
 

Hi Dave,
Thanks a lot for the great help!

It's a part of an on-line survey with a bit of statistical calculatio
involved.

Again, thanks.

Twinkl

--
twinklejm
-----------------------------------------------------------------------
twinklejmj's Profile: http://www.excelforum.com/member.php...fo&userid=2708
View this thread: http://www.excelforum.com/showthread.php?threadid=46870


Dave Peterson

Macro to randomize and delete accessed hyperlinks
 
Thanks for posting back.

twinklejmj wrote:

Hi Dave,
Thanks a lot for the great help!

It's a part of an on-line survey with a bit of statistical calculation
involved.

Again, thanks.

Twinkle

--
twinklejmj
------------------------------------------------------------------------
twinklejmj's Profile: http://www.excelforum.com/member.php...o&userid=27085
View this thread: http://www.excelforum.com/showthread...hreadid=468708


--

Dave Peterson


All times are GMT +1. The time now is 12:21 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com