We help IT Professionals succeed at work.

Add links and comment columns to index

Medium Priority
189 Views
Last Modified: 2012-05-11
The macro below creates a nice index tab for each study in the study tab.  I would like to add at least three (3) columns for comments that never get erased regardless of how often the index is recreated.  Studies will be added so it is necessary that the comments remain next to the same name of the study from where they are initially placed.

Assistance is hugely appreciated!
Sub create_Index()

'This code is designed to create an index in the active sheet for the tab named studies.'

    Dim lastRow As Long, Rw As Long
    Dim ws As Worksheet
    
    Set ws = Sheets.Add
    
    On Error Resume Next
    ws.Name = "Index"
    On Error GoTo 0
    
    lastRow = Sheets("studies").Range("A" & Rows.Count).End(xlUp).Row
    
    Rw = 1
    For i = 3 To lastRow
        If Len(Trim(Sheets("studies").Range("A" & i).Value)) <> 0 Then
            ws.Range("A" & Rw).Value = Sheets("studies").Range("A" & i).Value
            ws.Range("B" & Rw).Value = Sheets("studies").Range("B" & i).Value
            Rw = Rw + 1
        End If
    Next i
End Sub

Open in new window

tosstudies-6.14.xlsm
Comment
Watch Question

Ted

Do you want a fresh macro to be created where in it doesn't create the index sheet every time but simply update it with new indexes?

Sid

Author

Commented:
Yeah, that sounds better I think.  Thanks Sid.
Try this sample file.

Is this what you want?

Sid

Code Used

Sub create_Index()
    Dim lastRow As Long, Rw As Long, i As Long
    Dim ws As Worksheet
    Dim StrSearch As String
    
    Set ws = Sheets("Index")
    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
                Rw = Rw + 1
            End If
        End If
    Next i
End Sub

Open in new window

Tosstudies-6.14.xlsm

Author

Commented:
Just tried it on mine and it didn't run.  It gave this error >> http://screencast.com/t/3Mojhksvs

Author

Commented:
I think I see what you might have been trying to do.  Were you leaving the create module and then creating a new module to check?

I'd rather have all one module if possible that I could run over and over.  It would either create a new tab if one didn't exist, or update if one did exist.  

Assistance still needed.  Thanks Sid.
Ted. You have to use the latest code that I gave above and ignore the earlier code that I gave you. Also for it to work, please ensure that there is a sheet called "index" in the workbook.

Sid

Author

Commented:
That's the problem then.  I was only using the last code but had not created a tab called index.  Can the macro take care of that?

The reason is because a year from now when we update the doc with all the latest indicators, I won't remember that a pre-existing Index tab is needed and won't understand the error.  A year from now, none of the comments we make today will have much value, so the likelihood of erasing the tab and starting over at that point exists.
I just quickly wrote this. Could you please try this for me?

Sid

Code

Sub create_Index()
    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
                Rw = Rw + 1
            End If
        End If
    Next i
End Sub

Open in new window

Author

Commented:
That ran and created the index, but the D cells adjacent to each title in column D are intended to end up in column C of the Index.

Almost home Sid.  Thanks for your help.
Unlock this solution and get a sample of our free trial.
(No credit card required)
UNLOCK SOLUTION
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a sample view!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.