[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Update fixes needed

Posted on 2011-04-21
6
Medium Priority
?
219 Views
Last Modified: 2012-05-11
Updates, whether in the Study tab or in the Index tab, should be correctly reflected, and next to the correct study whenever the macro is re-run.
Sub create_Index()

'This code is designed to
'1. Create an index file that contains a link to numbered title columns.
'2. Add copyright copyright information from the same row.
'3. Create empty columns that can be edited from the Index tab itself.

'Re-applying the macro when new studies are added, should still maintain this information
'next to the correct study.

    Dim lastRow As Long, Rw As Long, i As Long
    Dim ws As Worksheet
    Dim StrSearch As String
    Dim rng As Range
    
    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
                On Error Resume Next
                ws.Hyperlinks.Add Anchor:=ws.Range("B" & Rw), Address:="", SubAddress:= _
                "Studies!B" & i, TextToDisplay:=Sheets("studies").Range("B" & i).Value
                On Error GoTo 0
                Rw = Rw + 1
            End If
        End If
    Next i
    
    lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    
    On Error Resume Next
    Set rng = ws.Range("A1:E" & lastRow)
    ws.ListObjects.Add(xlSrcRange, rng, , xlYes).Name = "Table3"
    ws.ListObjects("Table3").TableStyle = "TableStyleMedium15"
    On Error GoTo 0
    
    With ws.Cells
        .ColumnWidth = 170.14
        .RowHeight = 248.25
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
    End With
End Sub

Open in new window

tosstudies-6.18.xlsm
0
Comment
Question by:rtod2
  • 3
  • 3
6 Comments
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35445165
Ted, Which columns need to be updated in the Index Sheet? Col C?

Sid
0
 

Author Comment

by:rtod2
ID: 35445174
Yes.  The columns next to see need to accept new information as well, even as new data is added to the Study tab.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35445182
>>> The columns next to see need to accept new information as well,

So D and E in Index should pick up values from E and F from Studies?

Sid
0
Industry Leaders: 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: 35445201
Not exactly.  D and E in the Index are just for the Index.
0
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 2000 total points
ID: 35445242
Oh Ok.

Is this what you want?

Sub create_Index()
    Dim lastRow As Long, Rw As Long, i As Long
    Dim ws As Worksheet
    Dim StrSearch As String
    Dim rng As Range
    
    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
                On Error Resume Next
                ws.Hyperlinks.Add Anchor:=ws.Range("B" & Rw), Address:="", SubAddress:= _
                "Studies!B" & i, TextToDisplay:=Sheets("studies").Range("B" & i).Value
                On Error GoTo 0
                Rw = Rw + 1
                
                lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
                
                On Error Resume Next
                Set rng = ws.Range("A1:E" & lastRow)
                ws.ListObjects.Add(xlSrcRange, rng, , xlYes).Name = "Table3"
                ws.ListObjects("Table3").TableStyle = "TableStyleMedium15"
                On Error GoTo 0
            Else
                acell.Offset(, 2).Value = Sheets("studies").Range("D" & i).Value
            End If
        End If
    Next i
    
    With ws.Cells
        .ColumnWidth = 170.14
        .RowHeight = 248.25
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
    End With
End Sub

Open in new window


Sid
0
 

Author Closing Comment

by:rtod2
ID: 35445258
Great stuff!
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

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

Microsoft's Excel has many features that most people will never need nor take advantage of.  Conditional formatting is one feature that you may find a necessity once you start using it.
Windows Explorer let you handle zip folders nearly as any other folder: Copy, move, change, and delete, etc. In VBA you can also handle normal files and folders, but zip folders takes a little more - and that you'll find here.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

873 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