PDA

View Full Version : Sleeper: Using intersect method



malik641
09-12-2005, 05:02 AM
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
09-12-2005, 05:26 AM
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
09-12-2005, 07:10 AM
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
09-12-2005, 07:27 AM
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
09-12-2005, 09:30 AM
You need to use a Range in the Intersect method. Pass these parameters, not integers (e.g. Row(s) or Column(s)).

malik641
09-12-2005, 09:52 AM
Thanks mvidas for the help :thumb
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
09-13-2005, 04:46 AM
Okay, it's working pretty well now http://vbaexpress.com/forum/images/smilies/023.gif
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
09-13-2005, 08:03 AM
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
09-13-2005, 09:00 AM
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...:dunno

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

mvidas
09-13-2005, 09:35 AM
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
09-13-2005, 09:44 AM
BTW, I KNEW I shouldn't have marked it solved yet....:banghead:
Unmarked. ;)

malik641
09-13-2005, 09:47 AM
:thumb Nice!!:thumb
Thanks Zack!

malik641
09-15-2005, 01:46 PM
I think this could use a major overhaul, depending on exactly what you're doing http://vbaexpress.com/forum/images/smilies/001.gif 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 http://vbaexpress.com/forum/images/smilies/pray2.gif ) 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 http://vbaexpress.com/forum/images/smilies/023.gif