Sleeper: Using intersect method

[malik641]

When using the Intersect method, do the column and row have to be selected to work correctly?

Here's something similar to what I am using:

Function Productivity(date1 as Range, name1 As Range)
Application.Volatile True
Application.ScreenUpdating = False
Dim dateCol as Variant
Dim nameRow as Variant
Dim dateRng as Variant
Dim nameRng as Variant
Dim Total as Long
Dim val as Long
Total = 0
On Error Resume Next 
For each cell in Sheets("Sheet1").Cels.Range("A4:A31")
If cell.value = name1.value then
nameRng = cell.address(0,0)
nameRow = Range(nameRng).Row
Else
'Nothing
End If
Next Cell
For each cell in sheets("Sheet1").Cells.Range("B1:HA1")
If cell.value = date1.Value then
dateRng = cell.Address(0,0)
dateCol = Range(dateRng).Column
Else
'Nothing
End If
Next Cell
val = Intersect(dateCol, nameRow).Value
Productivity = val
End Function

I can't get the Intersect to work to obtain the value in the intersect of the two ranges. What am I doing wrong?

*Note: date1 and name1 are the arguements for the function. In the ranges given for sheet1 (in the VBE) if the arguements' contents match the cell's value, then obtain what column and row they are in. And then obtain the value in the intersect of that row and column.

[Bob Phillips]

You have a code error that is not trapped as you don't have option explicit (you use Cels instead of Cells), and you are passing Intersect va row and a column number when it works on ranges.

[malik641]

Sorry about the Cels instead of Cells, I typed this in instead of copy and pasted.
How would I select these columns and rows to be the ranges for the intersect method?

Would it be something like:

val = Intersect(dateCol.Column, nameRow.Row).Value

[mvidas]

Hi Joseph,

The intersect method intersects two (or more) range objects and returns the intersected range. Your use of it is intersecting "dateCol" and "nameRow". I've made quite a few changes for you, commented out some lines that aren't necessary, and added some things as well:

Function Productivity(date1 As Range, name1 As Range) As Long 'added "as long"
Application.Volatile 'True
' Application.ScreenUpdating = False
' Dim dateCol As Variant
' Dim nameRow As Variant
Dim dateRng As Range 'changed to Range
Dim nameRng As Range 'changed to Range
' Dim Total As Long
' Dim val As Long
' Total = 0
' On Error Resume Next
For Each Cell In Sheets("Sheet1").Range("A4:A31") 'removed .Cells
If Cell.Value = name1.Value Then
Set nameRng = Cell
' Else
' 'Nothing
'*** you may want to add/uncomment the following line, it will stop at first find
' Exit For
End If
Next Cell
For Each Cell In Sheets("Sheet1").Range("B1:HA1") 'removed .Cells
If Cell.Value = date1.Value Then
Set dateRng = Cell
' Else
' 'Nothing
'*** you may want to add/uncomment the following line, it will stop at first find
' Exit For
End If
Next Cell
If Not nameRng Is Nothing And Not dateRng Is Nothing Then 'added this line
'changed val to Productivity
Productivity = Intersect(dateRng.EntireColumn, nameRng.EntireRow).Value
End If 'added this line
' Productivity = val
End Function

Matt

[Zack Barresse]

You need to use a Range in the Intersect method. Pass these parameters, not integers (e.g. Row(s) or Column(s)).

[malik641]

Thanks mvidas for the help
I adjusted it to meet my requirements.

Here's what I ended up with:

Function Productivity(date1 As Range, name1 As Range) As Long
Application.Volatile
'On Error Resume Next
Dim dateRng As Range
Dim nameRng As Range
Dim WS As Range
Dim Total As Long
Total = 0
If date1 <= "25-Jun" Then
For Each WS In Range("Employees")
For Each cell In Sheets(WS.Text).Range("A4:A31")
If cell.Value = name1.Value Then
Set nameRng = cell
End If
Next cell
For Each cell In Sheets(WS.Text).Range("B1:HA1")
If cell.Value = date1.Value Then
Set dateRng = cell
End If
Next cell
Total = Total + Intersect(dateRng.EntireColumn, nameRng.EntireRow).Value
If Not nameRng Is Nothing And Not dateRng Is Nothing Then
Total = Total + Intersect(dateRng.EntireColumn, nameRng.EntireRow).Value
End If
Next WS
Else
For Each WS In Range("Employees")
For Each cell In Sheets(WS.Text).Range("A37:A64")
If cell.Value = name1.Value Then
Set nameRng = cell
End If
Next cell
For Each cell In Sheets(WS.Text).Range("B34:HB34")
If cell.Value = date1.Value Then
Set dateRng = cell
End If
Next cell
If Not nameRng Is Nothing And Not dateRng Is Nothing Then
Total = Total + Intersect(dateRng.EntireColumn, nameRng.EntireRow).Value
End If
Next WS
End If
Productivity = Total
End Function

There's still some bugs to work out, but those problems are probably from the worksheets that are called on. The function works like it should (at least, so far I have noticed).

And thanks for the info firefytr.

[malik641]

Okay, it's working pretty well now
Some of the problems were from the worksheet's the function called on, but I did have to change a little bit with the function. Here's what I ended up with:

Function Productivity(date1 As Range, name1 As Range) As Long
'Application.Volatile
On Error Resume Next
Dim dateRng As Range
Dim nameRng As Range
Dim WS As Range
Dim Total As Long
Const TableDate As Date = #6/25/2005#
Total = 0
If date1 <= TableDate Then
For Each WS In Range("Employees")
For Each cell In Sheets(WS.Text).Range("A4:A32")
If cell.Value = name1.Value Then
Set nameRng = cell
End If
Next cell
For Each cell In Sheets(WS.Text).Range("B1:HA1")
If cell.Value = date1.Value Then
Set dateRng = cell
End If
Next cell
If Not nameRng Is Nothing And Not dateRng Is Nothing Then
Total = Total + Intersect(dateRng.EntireColumn, nameRng.EntireRow).Value
End If
Next WS
Else
For Each WS In Range("Employees")
For Each cell In Sheets(WS.Text).Range("A37:A65")
If cell.Value = name1.Value Then
Set nameRng = cell
End If
Next cell
For Each cell In Sheets(WS.Text).Range("B34:HB34")
If cell.Value = date1.Value Then
Set dateRng = cell
End If
Next cell
If Not nameRng Is Nothing And Not dateRng Is Nothing Then
Total = Total + Intersect(dateRng.EntireColumn, nameRng.EntireRow).Value
End If
Next WS
End If
Productivity = Total
End Function

Thanks again for all your help!

[mvidas]

Glad we could help, Joseph! Though I'm still not sure why you have the "on error resume next" in there, I'm just going to assume you need it for some reason.
I made a little adjustment to your code, just to shorten it a little bit and remove the bit If block. Should have the same functionality, however:

Function Productivity(ByVal date1 As Range, ByVal name1 As Range) As Long
     'Application.Volatile
    On Error Resume Next
Dim dateRng As Range
    Dim nameRng As Range
    Dim RG1 As Range
    Dim RG2 As Range
    Dim WS As Range
    Dim Total As Long
    Const TableDate As Date = #6/25/2005#
Total = 0
For Each WS In Range("Employees").Cells
If date1 <= TableDate Then
            Set RG1 = Sheets(WS.Text).Range("A4:A32")
            Set RG2 = Sheets(WS.Text).Range("B1:HA1")
        Else
            Set RG1 = Sheets(WS.Text).Range("A37:A65")
            Set RG2 = Sheets(WS.Text).Range("B34:HB34")
        End If
For Each Cell In RG1.Cells
            If Cell.Value = name1.Value Then
                Set nameRng = Cell
            End If
        Next Cell
For Each Cell In RG2.Cells
            If Cell.Value = date1.Value Then
                Set dateRng = Cell
            End If
        Next Cell
If Not nameRng Is Nothing And Not dateRng Is Nothing Then
            Total = Total + Intersect(dateRng.EntireColumn, nameRng.EntireRow).Value
        End If
Next WS
Productivity = Total
End Function

Matt

[malik641]

Hey thanks Matt for the revision of that If block. I need this code to be as efficient as possible...I've been testing it (before your revised code) and it takes entirely too long to calculate the cells. I may have to figure out a formula instead of this function...but we'll see.

The reason for the 'On Error Resume Next' is because if there is no match with the name1 or date1 with the cell value, then the function will not procede to the worksheet(s) following the one it's in. This ends up with an incorrect total, unless I have the 'On Error Resume Next' code there, because then it goes to the next sheet. (I noticed this while testing the function without that '...Resume Next' code).

As for the calculations taking too long. I decided to set the workbook calculation to xlManual upon the open event. And then I set all the sheets (except for the one with all the functions that take too long to calculate) to recalculate on a worksheet_change event. Is there a more efficient way to handle this? I've tried the _BeforeSave and _BeforeClose and _Open event to calculate the entire workbook (even just the sheet with all the functions alone), but I can't decide which is the best way to handle it. And for some reason I can't get the sheet with the functions to calculate on a workbook_open event...

Any ideas??
BTW, I KNEW I shouldn't have marked it solved yet....

[mvidas]

Hi Joseph,

I think this could use a major overhaul, depending on exactly what you're doing Is there any way you could post the workbook here?

I'm guessing you're not using this function as a worksheet function (otherwise a lot of this wouldnt work), so I've streamlined this down even more. But I'm guessing if I can look at your actual workbook it would be a lot easier to find a better method for you. As it is, this is fast, but if you're still having problems with speed then we should look at the whole thing. I could also figure out why you're looping through each sheet of employees Either way, heres the next updated sub, and I'll try to get the Solved removed

Function Productivity(ByVal date1 As Range, ByVal name1 As Range) As Long
  'Application.Volatile
Dim dateCell As Range
 Dim nameCell As Range
 Dim NameRG As Range
 Dim DateRG As Range
 Dim Empl As Range
 Dim WS As Worksheet
 Dim Total As Long
 Const TableDate As Date = #6/25/2005#
Total = 0
For Each Empl In Range("Employees").Cells
  Set WS = Sheets(Empl.Text)
If date1 <= TableDate Then
   Set NameRG = WS.Range("A4:A32")
   Set DateRG = WS.Range("B1:HA1")
  Else
   Set NameRG = WS.Range("A37:A65")
   Set DateRG = WS.Range("B34:HB34")
  End If
Set nameCell = NameRG.Find(name1.Value, , xlValues, xlWhole, MatchCase:=False)
  Set dateCell = DateRG.Find(date1.Value, , xlFormulas)
If Not nameCell Is Nothing And Not dateCell Is Nothing Then
   Total = Total + WS.Cells(nameCell.Row, dateCell.Column).Value
  End If
Next 'Empl
Productivity = Total
End Function

[Zack Barresse]

BTW, I KNEW I shouldn't have marked it solved yet....

Unmarked.

[malik641]

Nice!!
Thanks Zack!

[malik641]

I think this could use a major overhaul, depending on exactly what you're doing Is there any way you could post the workbook here?

Yeah, this could use a major overhaul...I'm going to attempt to make a formula for this instead of this function. And I'll post a dummie workbook because my work would not be happy with me posting real documents online, but I'm sure no one will have a problem with a dummie workbook.

I'm guessing you're not using this function as a worksheet function (otherwise a lot of this wouldnt work).

Actually I am using this as a worksheet function. But it is placed in 2332 cells and each time the function is calculated it is searching through 10 sheets. That's why it is taking so long.

In the dummie workbook:
-Total Productivity Rate sheet is where the calculations are made
-Employees Names sheet holds the dynamic Named list of the sheets with the employee names
-Employee sheets hold the data
-Sheet1 is where I am testing formulas. The closest one (IMO) is where I'm trying to use the intersection method using Defined Names.

If you are a formula guru, I could use your help. This is pretty difficult.
Please take a look at this (ANYBODY ) and tell me what you think. You could even tell me to give up, as long as I know people are actually looking at this.

Thanks again