Macro to randomize and delete accessed hyperlinks

[twinklejmj]

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

[Dave Peterson]

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]

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

[Dave Peterson]

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