Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How to automate worksheet level named ranges for multiple sheets? 1

Status
Not open for further replies.

makeitwork09

Technical User
Sep 28, 2009
170
US
I am using Excel 2007 and I have the following macro which, from a range with a formula in the cells, finds the cell with the result (value) of 1. 

I used that to the determine the row. The row number is then used to make a range selection starting at the row where the 1 value was found, but in a different column. 

Using that selection, I use the sheet name to create a worksheet level named range. 

I need to enhance this code in the following way:
(1) I have several sheets where I need to repeat the above, therefore I need to loop through the sheets. I only need this for the sheets that have a name that is a number. 

(2) The column with the formula where the value is 1 is column A.  With the current code, if, when the macro is executed, the selected cell is not already in column A, the search for the value of 1 is done on the column that is selected at exectution, instead. I need to change that. I tried range(a1).select, but for some reason the rest of the code didn't work.

(3) If the value of 1 is not found I want to continue the next sheet 

(4) Below I only show one column that I am naming, but there is a second column where I need to do the same steps. 

If someone could assist with this that would be apprecitated. 

Code:
Sub FindPeriod1()
'
' FindPeriod1 Macro
'
' Keyboard Shortcut: Ctrl+p
'
Dim SheetName As String, NameAddress As String

    
    SheetName = "=" & Sheet4.Name & "!"
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Find(What:="1", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    Range("d" & ActiveCell.Row).Select
    NameAddress = Range(Selection, Selection.End(xlDown)).Select
    'Add the name MyRange

    ActiveSheet.Names.Add Name:="payment", RefersTo:=Selection
    'ActiveWorkbook.Names.Add(Name:="payment", RefersTo:=SheetName & NameAddress)
    
End Sub
 
\\hi,
Code:
Sub FP1()
    Dim rFound As Range, ws As Worksheet

    For Each ws In Worksheets
        If IsNumeric(ws.Name) Then
            Set rFound = ws.Columns(1).Find("1")
            
            If Not rFound Is Nothing Then
                Set rFound = ws.Range( _
                    ws.Cells(rFound.Row, "D"), _
                    ws.Cells(rFound.Row, "D").End(xlDown))
                
                ws.Names.Add Name:="payment", _
                    RefersTo:="='" & ws.Name & "'!" & rFound.Address
            End If
        End If
    Next
End Sub

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Thank you Skip. That was very helpful. I had to make a slight modification where I first select a cell in column 1 because the column(1) command was starting on the row of the selected cell.

I tried using the same code on column 1, changing the name of the range, but ran into a problem. As I mentioned in my post, column 1 is a formula field. Since the number of rows can vary on each sheet, the formula is copied down to several rows. If the condition of the formula is false the cell is blank. However, because there is something in the cell when End(xlDown) is used it's including rows that are blank. I tried using the last row index of column E to replace End(xlDown), however after several hours, I could not figure how to modify the code you provided with that row location.

I'm not as knowledgeable as you with the objects, methods, and properties as you, but would like to learn more about what you used. Many of the tutorials I've seen do not use the method that you used. I found your method easier to follow.

Thanks for your help.
 
As an example, I tried to use the following:

Code:
Cells(Cells.Rows.Count,"E").End(xlUp).Row
 
I figured out. I'm not sure this was the best way, but it's working.

Code:
Sub FoundRow()
   Dim rPeriod As Range, rPrincipal As Range, rRowFound As Range, ws As
Worksheet, LastRow As Long, CFLastRow As Integer

   For Each ws In Worksheets
       If IsNumeric(ws.Name) Then
           Range("A4").Select
           Set rRowFound = ws.Columns(1).Find(what:="1",
after:=ActiveCell, LookIn:=xlValues, LookAt:= _
       xlPart, searchorder:=xlByRows, searchdirection:=xlNext,
MatchCase:=False _
       , SearchFormat:=False)

           If Not rRowFound Is Nothing Then

               LastRow = ws.Cells(Cells.Rows.Count, "E").End(xlUp).Row
               CFLastRow = LastRow

               Set rPrincipal = ws.Range( _
                   ws.Cells(rRowFound.Row, "E"), _
                   ws.Cells(rRowFound.Row, "E").End(xlDown))

               Set rPeriod = ws.Range("A" & rRowFound.Row, "A" &
CFLastRow)

               ws.Names.Add Name:="principal", _
                   RefersTo:="='" & ws.Name & "'!" & rPrincipal.Address

               ws.Names.Add Name:="period", _
                   RefersTo:="='" & ws.Name & "'!" & rPeriod.Address

           End If
       End If
   Next
End Sub
 
You really ought to avoid SELECTING if at all possible.

Rather, reference the range explicitly, along with [red]the sheet reference[/red]...
Code:
'.....
       If IsNumeric(ws.Name) Then
           Set rRowFound = ws.Columns(1).Find(what:="1", _
                after:=[b][red]ws.[/red]Range("A4")[/b], LookIn:=xlValues, LookAt:= _
                xlPart, searchorder:=xlByRows, searchdirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
'.....

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Thanks Skip,

Can you please (1) explain why it is best to avoid selecting? and (2) direct me to a tutorial or book that references the code like you do. It seems that you know best practices and alternatives to the run macro generated code.

Thanks so much for your help
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top