Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Add links and comment columns to index

Posted on 2011-04-20
11
Medium Priority
?
171 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
0
Comment
Question by:rtod2
  • 6
  • 5
11 Comments
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35438658
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

0
 

Author Comment

by:rtod2
ID: 35438686
Yeah, that sounds better I think.  Thanks Sid.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35438820
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
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:rtod2
ID: 35442641
Just tried it on mine and it didn't run.  It gave this error >> http://screencast.com/t/3Mojhksvs
0
 

Author Comment

by:rtod2
ID: 35442654
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.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35442871
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
0
 

Author Comment

by:rtod2
ID: 35442965
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.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35443003
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

0
 

Author Comment

by:rtod2
ID: 35443155
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.
0
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 2000 total points
ID: 35443238
So you mean like this?

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
                ws.Range("C" & Rw).Value = Sheets("studies").Range("D" & i).Value
                Rw = Rw + 1
            End If
        End If
    Next i
End Sub

Open in new window


Sid
0

Featured Post

[Webinar] Database Backup and Recovery

Does your company store data on premises, off site, in the cloud, or a combination of these? If you answered “yes”, you need a data backup recovery plan that fits each and every platform. Watch now as as Percona teaches us how to build agile data backup recovery plan.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
Enter Foreign and Special Characters Enter characters you can't find on a keyboard using its ASCII code ... and learn how to make a handy reference for yourself using Excel ~ Use these codes in any Windows application! ... whether it is a Micr…

572 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question