Applying names to ranges of cells for formulas

[MMH]

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

[Norman Jones]

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" <[email protected]> wrote in message
news:[email protected]...
>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

[MMH]

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

[Norman Jones]

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" <[email protected]> wrote in message
news:[email protected]...
> 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

[Norman Jones]

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" <[email protected]> wrote in message
news:[email protected]...
> 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]

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

[Norman Jones]

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" <[email protected]> wrote in message
news:[email protected]...
> 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

[MMH]

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

[Norman Jones]

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" <[email protected]> wrote in message
news:[email protected]...
> 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

[Norman Jones]

Hi MMH,

That should be:

nXorman_jXones@btXconnectDOTcom

(replace dot and remove each X) :

---
Regards,
Norman



"Norman Jones" <[email protected]> wrote in message
news:[email protected]...
> 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" <[email protected]> wrote in message
> news:[email protected]...
>> 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
>
>