Applying names to ranges of cells for formulas

[Guest]

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.

 

[Guest]

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.

 

[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.

 

[Guest]

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]

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

 

[Guest]

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]

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

 

[Norman Jones]

Hi MMH,

That should be:

nXorman_jXones@btXconnectDOTcom

(replace dot and remove each X) :

 

[Guest]

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