Applying names to ranges of cells for formulas
 

I am writing a macro that takes data from a sheet showing amounts invoiced in
a given month, decides what type of work was invoiced, and calclulates totals
for the different types of work.

I have one worksheet that shows the values billed in column E, and the type
of work billed in column F. I want to find all cells in column F with the
same type/value, then select the corresponding cells in column E, and apply a
name to the range that I can then insert into formulas.

The code I am using to do this is shown below. The problem I have is that
if a particular term I search for is not in column F, all the rows in column
E will be selected (which doesn't help me much).

What I would like to do is change the code to say that if there are no
matching entries in column F, no range is created. And later when I create
my formulas, I want something to say that if a particular range doesn't
exist, the value of the cell should be zero.

Any help doing this would be appreciated.

Thanks
MMH

***

'
' Creating Name for Search range to use in later formula
'
Selection.AutoFilter Field:=6, Criteria1:="Search"
Range("A1").Select
Cells.Find(What:="Search", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase _
:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, -1).Select
Range(Selection, Selection.End(xlDown)).Name = "Search"
'
' Get values of search column from this month's workbook
'
Sheets("YTD Totals").Select
Range("E8").Select
ActiveCell.FormulaR1C1 = "=SUM(Search)"
Range("E9").Select

Applying names to ranges of cells for formulas
 

Hi MMH,

Your code relies on making physical selections This is rarely necessary or
desirable.

Try instead:

'============================
Sub Tester()

Dim Rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Const sStr As String = "Search" '<<==== Autofilter Criterion
Dim sh As Worksheet

Set sh = Sheets("Sheet1") '<<====== CHANGE

'CHANGE A1 to the first Autofilter cell
sh.Range("A1").AutoFilter Field:=6, Criteria1:=sStr

Set Rng1 = sh.AutoFilter.Range
Set rng2 = Rng1.Offset(1).Resize(Rng1.Rows.Count - 1)
Set rng3 = rng2.Columns(6)

On Error Resume Next
Set rng4 = rng3.Offset(, -1). _
SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not rng4 Is Nothing Then
rng4.Name = "Search"
Else
ActiveWorkbook.Names.Add Name:= _
"Search", RefersToR1C1:="=0"
End If

Sheets("YTD Totals").Range("E8").FormulaR1C1 = _
"=SUM(Search)"
End Sub

'<<============================

Amend the worksheet name to accord with your situation and, in the following
line, change "A1" to reflect the first cell reference of your Autofilter
range.

---
Regards,
Norman



"MMH" wrote in message
...
I am writing a macro that takes data from a sheet showing amounts invoiced
in
a given month, decides what type of work was invoiced, and calclulates
totals
for the different types of work.

I have one worksheet that shows the values billed in column E, and the
type
of work billed in column F. I want to find all cells in column F with the
same type/value, then select the corresponding cells in column E, and
apply a
name to the range that I can then insert into formulas.

The code I am using to do this is shown below. The problem I have is that
if a particular term I search for is not in column F, all the rows in
column
E will be selected (which doesn't help me much).

What I would like to do is change the code to say that if there are no
matching entries in column F, no range is created. And later when I
create
my formulas, I want something to say that if a particular range doesn't
exist, the value of the cell should be zero.

Any help doing this would be appreciated.

Thanks
MMH

***

'
' Creating Name for Search range to use in later formula
'
Selection.AutoFilter Field:=6, Criteria1:="Search"
Range("A1").Select
Cells.Find(What:="Search", After:=ActiveCell, LookIn:=xlFormulas,
LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase _
:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, -1).Select
Range(Selection, Selection.End(xlDown)).Name = "Search"
'
' Get values of search column from this month's workbook
'
Sheets("YTD Totals").Select
Range("E8").Select
ActiveCell.FormulaR1C1 = "=SUM(Search)"
Range("E9").Select

Applying names to ranges of cells for formulas
 

Thanks Norman

That worked very well for "Search". Unfortunately I then tried to apply the
code to the next range I required (Application), which isn't in the test data
I am using. I ended up getting the "Run-time error '1004': No cells were
found' error message.

I have a sneaking suspicion I have duplicated some code that I don't need
to, but I cannot work out exactly what I need to change to make this work.
Here is what I have done:

Dim Rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Const sStr As String = "Search"
Const sStr2 As String = "Application"
Dim sh As Worksheet

Set sh = Sheets("This Month")

' Search
sh.Range("F1").AutoFilter Field:=6, Criteria1:=sStr

Set Rng1 = sh.AutoFilter.Range
Set rng2 = Rng1.Offset(1).Resize(Rng1.Rows.Count - 1)
Set rng3 = rng2.Columns(6)

On Error Resume Next
Set rng4 = rng3.Offset(, -1). _
SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not rng4 Is Nothing Then
rng4.Name = "Search"
Else
ActiveWorkbook.Names.Add Name:= _
"Search", RefersToR1C1:="=0"
End If

' Application
sh.Range("F1").AutoFilter Field:=6, Criteria1:=sStr2

Set Rng1 = sh.AutoFilter.Range
Set rng2 = Rng1.Offset(1).Resize(Rng1.Rows.Count - 1)
Set rng3 = rng2.Columns(6)

On Error Resume Next
Set rng4 = rng3.Offset(, -1). _
SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not rng4 Is Nothing Then
rng4.Name = "Application"
Else
ActiveWorkbook.Names.Add Name:= _
"Application", RefersToR1C1:="=0"
End If


Sheets("YTD Totals").Range("E8").FormulaR1C1 = _
"=SUM(Search)"
Sheets("YTD Totals").Range("E9").FormulaR1C1 = _
"=SUM(Application)"


If you could help me out on this I would really appreciate it.

Thanks
MMH

Applying names to ranges of cells for formulas
 

Hi MMH,

For your revised requirements, try the following.

'============================
Sub Tester2()
Dim Rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Dim Arr As Variant
Dim i As Long
Dim sh As Worksheet

Arr = Array("Search", "Application")

For i = LBound(Arr) To UBound(Arr)

Set sh = Sheets("This Month")

sh.Range("F1").AutoFilter Field:=6, Criteria1:=Arr(i)

Set Rng1 = sh.AutoFilter.Range
Set rng2 = Rng1.Offset(1).Resize(Rng1.Rows.Count - 1)
Set rng3 = rng2.Columns(6)

On Error Resume Next
Set rng4 = rng3.Offset(, -1). _
SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not rng4 Is Nothing Then
rng4.Name = Arr(i)
Else
ActiveWorkbook.Names.Add Name:= _
Arr(i), RefersToR1C1:="=0"
End If

Sheets("YTD Totals").Range("E8")(i + 1).FormulaR1C1 = _
"=SUM(" & Arr(i) & ")"

Set Rng1 = Nothing
Set rng2 = Nothing
Set rng3 = Nothing
Set rng4 = Nothing

Next i

End Sub
'<<============================

Note that:

(1) I have replaced the single sStr constant search string with an array
(Arr) of search strings. If you need to extract additional YTD results,
simply apen the additional search string(s) to Arr. As written, each
additional query result will be posted sequentially below the previous
results in column E on the YTD sheet.

(2)Rather than atttempting to repeat the entire code for each additional
search string, I construct repeat loops, re-initialising range variables at
each pass.


---
Regards,
Norman



"MMH" wrote in message
...
Thanks Norman

That worked very well for "Search". Unfortunately I then tried to apply
the
code to the next range I required (Application), which isn't in the test
data
I am using. I ended up getting the "Run-time error '1004': No cells were
found' error message.

I have a sneaking suspicion I have duplicated some code that I don't need
to, but I cannot work out exactly what I need to change to make this work.
Here is what I have done:

Dim Rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Const sStr As String = "Search"
Const sStr2 As String = "Application"
Dim sh As Worksheet

Set sh = Sheets("This Month")

' Search
sh.Range("F1").AutoFilter Field:=6, Criteria1:=sStr

Set Rng1 = sh.AutoFilter.Range
Set rng2 = Rng1.Offset(1).Resize(Rng1.Rows.Count - 1)
Set rng3 = rng2.Columns(6)

On Error Resume Next
Set rng4 = rng3.Offset(, -1). _
SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not rng4 Is Nothing Then
rng4.Name = "Search"
Else
ActiveWorkbook.Names.Add Name:= _
"Search", RefersToR1C1:="=0"
End If

' Application
sh.Range("F1").AutoFilter Field:=6, Criteria1:=sStr2

Set Rng1 = sh.AutoFilter.Range
Set rng2 = Rng1.Offset(1).Resize(Rng1.Rows.Count - 1)
Set rng3 = rng2.Columns(6)

On Error Resume Next
Set rng4 = rng3.Offset(, -1). _
SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not rng4 Is Nothing Then
rng4.Name = "Application"
Else
ActiveWorkbook.Names.Add Name:= _
"Application", RefersToR1C1:="=0"
End If


Sheets("YTD Totals").Range("E8").FormulaR1C1 = _
"=SUM(Search)"
Sheets("YTD Totals").Range("E9").FormulaR1C1 = _
"=SUM(Application)"


If you could help me out on this I would really appreciate it.

Thanks
MMH

Applying names to ranges of cells for formulas
 

Hi MMH,

Or, more efficiently:

'============================
Sub Tester3()
Dim Rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Dim Arr As Variant
Dim i As Long
Dim sh As Worksheet

Arr = Array("Search", "Application")

Set sh = Sheets("This Month")

Set Rng1 = sh.AutoFilter.Range
Set rng2 = Rng1.Offset(1).Resize(Rng1.Rows.Count - 1)
Set rng3 = rng2.Columns(6)

For i = LBound(Arr) To UBound(Arr)

sh.Range("F1").AutoFilter Field:=6, Criteria1:=Arr(i)

On Error Resume Next
Set rng4 = rng3.Offset(, -1). _
SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not rng4 Is Nothing Then
rng4.Name = Arr(i)
Else
ActiveWorkbook.Names.Add Name:= _
Arr(i), RefersToR1C1:="=0"
End If

Sheets("YTD Totals").Range("E8")(i + 1).FormulaR1C1 = _
"=SUM(" & Arr(i) & ")"

Set rng4 = Nothing
Next i

End Sub
'<<============================

In this version, I have moved all the range variables, except for rng4 out
of the loop and only re-initialise this latter range variable.

---
Regards,
Norman



"Norman Jones" wrote in message
...
Hi MMH,

For your revised requirements, try the following.

'============================
Sub Tester2()
Dim Rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Dim Arr As Variant
Dim i As Long
Dim sh As Worksheet

Arr = Array("Search", "Application")

For i = LBound(Arr) To UBound(Arr)

Set sh = Sheets("This Month")

sh.Range("F1").AutoFilter Field:=6, Criteria1:=Arr(i)

Set Rng1 = sh.AutoFilter.Range
Set rng2 = Rng1.Offset(1).Resize(Rng1.Rows.Count - 1)
Set rng3 = rng2.Columns(6)

On Error Resume Next
Set rng4 = rng3.Offset(, -1). _
SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not rng4 Is Nothing Then
rng4.Name = Arr(i)
Else
ActiveWorkbook.Names.Add Name:= _
Arr(i), RefersToR1C1:="=0"
End If

Sheets("YTD Totals").Range("E8")(i + 1).FormulaR1C1 = _
"=SUM(" & Arr(i) & ")"

Set Rng1 = Nothing
Set rng2 = Nothing
Set rng3 = Nothing
Set rng4 = Nothing

Next i

End Sub
'<<============================

Note that:

(1) I have replaced the single sStr constant search string with an array
(Arr) of search strings. If you need to extract additional YTD results,
simply apen the additional search string(s) to Arr. As written, each
additional query result will be posted sequentially below the previous
results in column E on the YTD sheet.

(2)Rather than atttempting to repeat the entire code for each additional
search string, I construct repeat loops, re-initialising range variables
at each pass.


---
Regards,
Norman

Applying names to ranges of cells for formulas
 

Blast - still getting the same error message.

When I click Debug, the line "Set rng4 = rng3.Offset(, -1).
_SpecialCells(xlCellTypeVisible)" is highlighted.

MMH

"Norman Jones" wrote:

Hi MMH,

Or, more efficiently:

'============================
Sub Tester3()
Dim Rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Dim Arr As Variant
Dim i As Long
Dim sh As Worksheet

Arr = Array("Search", "Application")

Set sh = Sheets("This Month")

Set Rng1 = sh.AutoFilter.Range
Set rng2 = Rng1.Offset(1).Resize(Rng1.Rows.Count - 1)
Set rng3 = rng2.Columns(6)

For i = LBound(Arr) To UBound(Arr)

sh.Range("F1").AutoFilter Field:=6, Criteria1:=Arr(i)

On Error Resume Next
Set rng4 = rng3.Offset(, -1). _
SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not rng4 Is Nothing Then
rng4.Name = Arr(i)
Else
ActiveWorkbook.Names.Add Name:= _
Arr(i), RefersToR1C1:="=0"
End If

Sheets("YTD Totals").Range("E8")(i + 1).FormulaR1C1 = _
"=SUM(" & Arr(i) & ")"

Set rng4 = Nothing
Next i

End Sub
'<<============================

In this version, I have moved all the range variables, except for rng4 out
of the loop and only re-initialise this latter range variable.

---
Regards,
Norman

Applying names to ranges of cells for formulas
 

Hi MMH,

Blast - still getting the same error message.

When I click Debug, the line "Set rng4 = rng3.Offset(, -1).
_SpecialCells(xlCellTypeVisible)" is highlighted.


I could only replicate your "Run-time error '1004': No cells were found"
error, if I failed to wrap the assignment line with an error handler to
catch the possibility that the autofilter return no filter results for one
(or more) search strings.

Did you copy/paste my code (to avoid possible trancsription errors) and is
your problem line enclosed thus:

On Error Resume Next '<<=========== REQUIRED
Set rng4 = rng3.Offset(, -1). _
SpecialCells(xlCellTypeVisible)
On Error GoTo 0 '<<=========== REQUIRED


---
Regards,
Norman



"MMH" wrote in message
...
Blast - still getting the same error message.

When I click Debug, the line "Set rng4 = rng3.Offset(, -1).
_SpecialCells(xlCellTypeVisible)" is highlighted.

MMH

"Norman Jones" wrote:

Hi MMH,

Or, more efficiently:

'============================
Sub Tester3()
Dim Rng1 As Range, rng2 As Range
Dim rng3 As Range, rng4 As Range
Dim Arr As Variant
Dim i As Long
Dim sh As Worksheet

Arr = Array("Search", "Application")

Set sh = Sheets("This Month")

Set Rng1 = sh.AutoFilter.Range
Set rng2 = Rng1.Offset(1).Resize(Rng1.Rows.Count - 1)
Set rng3 = rng2.Columns(6)

For i = LBound(Arr) To UBound(Arr)

sh.Range("F1").AutoFilter Field:=6, Criteria1:=Arr(i)

On Error Resume Next
Set rng4 = rng3.Offset(, -1). _
SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not rng4 Is Nothing Then
rng4.Name = Arr(i)
Else
ActiveWorkbook.Names.Add Name:= _
Arr(i), RefersToR1C1:="=0"
End If

Sheets("YTD Totals").Range("E8")(i + 1).FormulaR1C1 = _
"=SUM(" & Arr(i) & ")"

Set rng4 = Nothing
Next i

End Sub
'<<============================

In this version, I have moved all the range variables, except for rng4
out
of the loop and only re-initialise this latter range variable.

---
Regards,
Norman

Applying names to ranges of cells for formulas
 

Hi Norman

I did copy and paste your code. So what I have is:

On Error Resume Next
Set rng4 = rng3.Offset(, -1). _
SpecialCells(xlCellTypeVisible)
On Error GoTo 0

I think I'm going to have to admit defeat on this one. Thank you for all
your help.

MMH

"Norman Jones" wrote:

Hi MMH,

I could only replicate your "Run-time error '1004': No cells were found"
error, if I failed to wrap the assignment line with an error handler to
catch the possibility that the autofilter return no filter results for one
(or more) search strings.

Did you copy/paste my code (to avoid possible trancsription errors) and is
your problem line enclosed thus:

On Error Resume Next '<<=========== REQUIRED
Set rng4 = rng3.Offset(, -1). _
SpecialCells(xlCellTypeVisible)
On Error GoTo 0 '<<=========== REQUIRED


---
Regards,
Norman

Applying names to ranges of cells for formulas
 

Hi MMH,

If you want to send me a copy of your workbook, I will endeavour to resolve
your problem

Replace or delete any sensitive information, but check that the problem
still exists.

(replace dot and remove each X) :

nXorman_jXones@btXinternetDOTcom


---
Regards,
Norman



"MMH" wrote in message
...
Hi Norman

I did copy and paste your code. So what I have is:

On Error Resume Next
Set rng4 = rng3.Offset(, -1). _
SpecialCells(xlCellTypeVisible)
On Error GoTo 0

I think I'm going to have to admit defeat on this one. Thank you for all
your help.

MMH

"Norman Jones" wrote:

Hi MMH,

I could only replicate your "Run-time error '1004': No cells were found"
error, if I failed to wrap the assignment line with an error handler to
catch the possibility that the autofilter return no filter results for
one
(or more) search strings.

Did you copy/paste my code (to avoid possible trancsription errors) and
is
your problem line enclosed thus:

On Error Resume Next '<<=========== REQUIRED
Set rng4 = rng3.Offset(, -1). _
SpecialCells(xlCellTypeVisible)
On Error GoTo 0 '<<=========== REQUIRED


---
Regards,
Norman

Applying names to ranges of cells for formulas
 

Hi MMH,

That should be:

nXorman_jXones@btXconnectDOTcom

(replace dot and remove each X) :

---
Regards,
Norman



"Norman Jones" wrote in message
...
Hi MMH,

If you want to send me a copy of your workbook, I will endeavour to
resolve your problem

Replace or delete any sensitive information, but check that the problem
still exists.

(replace dot and remove each X) :

nXorman_jXones@btXinternetDOTcom


---
Regards,
Norman



"MMH" wrote in message
...
Hi Norman

I did copy and paste your code. So what I have is:

On Error Resume Next
Set rng4 = rng3.Offset(, -1). _
SpecialCells(xlCellTypeVisible)
On Error GoTo 0

I think I'm going to have to admit defeat on this one. Thank you for all
your help.

MMH

"Norman Jones" wrote:

Hi MMH,

I could only replicate your "Run-time error '1004': No cells were found"
error, if I failed to wrap the assignment line with an error handler to
catch the possibility that the autofilter return no filter results for
one
(or more) search strings.

Did you copy/paste my code (to avoid possible trancsription errors) and
is
your problem line enclosed thus:

On Error Resume Next '<<=========== REQUIRED
Set rng4 = rng3.Offset(, -1). _
SpecialCells(xlCellTypeVisible)
On Error GoTo 0 '<<=========== REQUIRED


---
Regards,
Norman

Applying names to ranges of cells for formulas
 

Thanks for all your help, but I've managed to achieve the effect I want using
the SUMIF function.

So what I now have is:

Range("E2").Select
Range(Selection, Selection.End(xlDown)).Name = "Values"
Range("F2").Select
Range(Selection, Selection.End(xlDown)).Name = "Column"
Sheets("YTD Totals").Select
Range("E8").Select
ActiveCell.FormulaR1C1 = "=SUMIF(Column,""Search"",Values)"
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=SUMIF(Column,""Application"",Values)"

Thank you once again for all your help - you've gone beyond the call of duy
on this one.

MMH