rtod2
asked on
Modify macro to include links
I need to modify the existing macro to have the index create links back to the original study row. It would also be helpful if the rows in the index could have the default alternating color fills so as to make the index easier to navigate.
Sub Create_Index()
'This code is designed to create an index file that contains numbered title columns and a copyright
'column derived from the Studies tab. It also should create empty columns that can be edited from
'the Index tab itself.
'Re-applying the macro when new studies are added, should still maintain the position of the comments
'next to the correct study.
Dim lastRow As Long, Rw As Long, i As Long
Dim ws As Worksheet
Dim StrSearch As String
On Error Resume Next
Set ws = Sheets("Index")
On Error GoTo 0
If ws Is Nothing Then
Set ws = Sheets.Add
ws.Name = "Index"
End If
Rw = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
lastRow = Sheets("studies").Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To lastRow
If Len(Trim(Sheets("studies").Range("A" & i).Value)) <> 0 Then
StrSearch = Sheets("studies").Range("A" & i).Value
Set aCell = ws.Range("A1:A" & Rw).Find(What:=StrSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If aCell Is Nothing Then
ws.Range("A" & Rw).Value = Sheets("studies").Range("A" & i).Value
ws.Range("B" & Rw).Value = Sheets("studies").Range("B" & i).Value
ws.Range("C" & Rw).Value = Sheets("studies").Range("D" & i).Value
Rw = Rw + 1
End If
End If
Next i
End Sub
tosstudies-6.15.xlsm
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Unbelievable!
Glad to be of help :)
Sid
Sid
Open in new window
Sid