• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Using a VBA to pull information from other sheets and then name the set

O

OleMiss2010

Member
Essentially I have a name cell in every tab of a workbook. I am trying to pull those names onto the summary tab and then Name the list of names so that some equations being referenced by the Name will be correctly filled. I know there has to be a less complicated code than what I've written (which doesn't work anyway) to accomplish this goal. My code is below and I think it pretty clearly shows what I'm trying to do, I'm just not sure what needs to be fixed.

[pre]
Code: 
Sub Relationship_List()

If Cells <> Range("L1") Then
If ActiveCell = Range("L1") Then
For Each Cell In ThisWorkbook.Sheets("Summary").Columns("L:L")
Cell.Select
For Each Worksheet In ThisWorkbook.Worksheets
If Worksheet.Name <> "Summary" Then
Cells = Worksheet.Range("C5")
End If
Next Worksheet
Next Cell
End If
End If

Sheets("Summary").Columns("L:L").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, Skipblanks _
:=False, Transpose:=False
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Summary").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Summary").Sort.SortFields.Add Key:=Range("L:L") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Summary").Sort
.SetRange Range("L:L")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Names("SheetList").Delete
With ActiveWorkbook.Worksheets("Summary").Range("L:L")
If Cells <> Range("L1") Then
If Cells <> "" And Cells <> "<>" Then
.Select
ActiveWorkbook.Names.Add Name:="SheetList", RefersToR1C1:=Selection
End If
End If
End With

End Sub
[/pre]
 
Need some help on clarification...

What is the intent of this line?

If Cells <> Range("L1") Then


It also looks like there's some sorting going on in middle...are you just trying to sort the list of values you created alphabetically, or is there something else going on?


At end, we just want to define the summary list as a larger named range, correct?


Do we always need to delete "SheetList"?
 
1) Cell L1 is the title of the list of names so I don't want one of the names to overwrite that cell. I want the list to start in L2


2) That is correct on the sorting.


3) That is my goal with the list. I want to select all of cells L2:L??? that are occupied and name them SheetList


4) Since this macro could be performed several times in the life of this workbook I wasn't sure if it was necessary to delete SheetList in order to name the list SheetList or if it would automatically overwrite it.
 
Try this for making up the list:


Sub MakeList()

Dim ws As Worksheet

Dim r As Integer

Dim c As Integer

Dim strRange As String


r = 1

c = 12

For Each ws In ThisWorkbook.Worksheets

If ws.Name <> "Summary" Then

r = r + 1

Worksheets("Summary").Cells(r, c) = ws.Range("C5")

End If

Next ws


strRange = "=Summary!R2C12:R" & r & "C12"


ActiveWorkbook.Names.Add Name:="SheetList", RefersTo:=strRange


With ActiveWorkbook.Worksheets("Summary").Sort

.SetRange Range("L:L")

.Header = xlYes

.Apply

End With

End Sub
 
[pre]
Code: 
Sub Relationship_List()
Dim CellCount As Integer
Dim ws As Worksheet
Dim c As Range

'We'll use this to keep track of how many
'records we have in the list
CellCount = 1

With Worksheets("Summary")
'Fill in cells
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Summary" Then
CellCount = CellCount + 1
.Cells(CellCount, "L") = ws.Range("C5").Value
End If
Next ws

'Sort cells
.Range("L1", .Cells(CellCount, "L")).Sort Key1:=.Range("L1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Define Name
ThisWorkbook.Names.Add Name:="SheetList", RefersToR1C1:= _
"=Summary!R2C12:R" & CellCount & "C12"
End With

End Sub
[/pre]
 
Thanks Vaskov17 and Luke M.


Luke M, I put your code in and inserted my code for removing any 0's that arise from blank names. The only issue I see is that when the 0's are removed and actual names are left it is grabbing the cells that used to have 0's and putting them under the SheetList name, which creates a problem for some of the SheetList references elsewhere. I assume this is related to the CellCount component but am not sure how to correct for this.
 
Ah, I wasn't sure what that was doing. Yes, the CellCount would no longer be a good reference. To figure out how many cells we need in the range, could do something like:

[pre]
Code: 
CellCount = Range("L65536").End(xlUp).Row
[/pre]
After you've done the find and replace. This will "reset" the counter to the proper amount, and then all the following code should work properly.
 
So I've decided that instead of just making a list of the C5s from every sheet I should make that list hyperlink back to each sheet. I replaced:

[pre]
Code: 
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Summary" Then
CellCount = CellCount + 1
.Cells(CellCount, "L") = ws.Range("C5").Value
End If
Next ws

With:

For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Summary" Then
CellCount = CellCount + 1
.Hyperlinks.Add Anchor:=.Cells(CellCount, "L"), Address:="", _
SubAdress:=ws.Range("C5"), TextToDisplay:=ws.Range("C5").Value
End If
Next ws
[/pre]
This gives me an error.
 
For the subaddress, the VB was trying to use the value in ws.Range("C5"). This should do it:

[pre]
Code: 
With Worksheets("Summary")
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Summary" And ws.Range("C5") <> "" Then
CellCount = CellCount + 1
.Hyperlinks.Add Anchor:=.Cells(CellCount, "L"), Address:="", SubAddress:="'" & ws.Name & "'!C5", _
TextToDisplay:=ws.Range("C5").Value
End If
Next ws
End With
[/pre]
Also, I realized we could simply check for blank C5's up front, rather than having to go back later with a Find & Replace. =P
 
I'm getting an invalid procedure/argument at:

`.Hyperlinks.Add Anchor:=.Cells(CellCount, "L"), Address:="", SubAddress:="'" & ws.Name & "'!C5", _

TextToDisplay:=ws.Range("C5").Value`
 
You must log in or register to reply here.
Back
Top