View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Bob Phillips Bob Phillips is offline
external usenet poster
 
Posts: 10,593
Default match multiple criteria using VBA

have n o idea what it does but this tidies a few bits. It would help if you
gave more detail when you post, we can't raed your mind

Function gather2(cond As String, HI As Integer, mode As Integer) As Double
Dim nrow As Integer
Dim ncol As Integer
Dim ans As Double
Dim mysheet As Worksheet
Dim hrange As Range
Dim mrange As Range
Dim frange As Range
Dim FinalRow As Long

Set mysheet = Worksheets("Results")

ncol = Application.WorksheetFunction.Match(cond, mysheet.Range("1:1"), 0)
FinalRow = mysheet.Cells(mysheet.Rows.Count, ncol).End(xlUp).Row
Set hrange = mysheet.Cells(3, ncol).Resize(FinalRow - 2, 1)
Set mrange = mysheet.Cells(3, ncol - 1).Resize(FinalRow - 2, 1)
Set frange = mysheet.Cells(3, ncol + 1).Resize(FinalRow - 2, 1)

If HI = 0 Or HI = Application.WorksheetFunction.Floor((Range("NB") / 2), 1)
Then

nrow = mysheet.Evaluate("Match(1,(" & hrange.Address & "=" & HI & _
")*(" & mrange.Address & "=" & mode & "),0)")

ElseIf HI 0 And HI < Application.WorksheetFunction.Floor((Range("NB") /
2), 1) Then

nrow = mysheet.Evaluate("Match(1,(" & hrange.Address & "=" & HI & _
")*(" & mrange.Address & "=" & mode & "*2),0)")

End If

ans = Application.WorksheetFunction.Index(mysheet.Rows(" 3:65536"), nrow,
ncol + 1)
gather2 = ans
End Function

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"anna" wrote in message
...
Could someone please tell me why my computer hates me...
Here's my code, not sure why it won't work. I've tried my variations of

it.
Any ideas??? (By the way, "NB" is a named reference within the workbook.)

Function gather2(cond As String, HI As Integer, mode As Integer) As Double
Dim nrow As Integer
Dim ncol As Integer
Dim ans As Double
Dim mysheet As Worksheet
Dim hrange As Range
Dim mrange As Range
Dim frange As Range
Dim FinalRow As Integer

Set mysheet = Worksheets("Results")

ncol = Application.WorksheetFunction.Match(cond, mysheet.Range("1:1"), 0)
FinalRow = mysheet.Cells(Row.Count, ncol).End(xlUp).Row
Set hrange = mysheet.[cells(3,ncol)].Resize(FinalRow - 2, 1)
Set mrange = mysheet.[cells(3,ncol-1)].Resize(FinalRow - 2, 1)
Set frange = mysheet.[cells(3,ncol+1)].Resize(FinalRow - 2, 1)

If HI = 0 Or HI = Application.WorksheetFunction.Floor((Range("NB") / 2),

1)
Then

nrow = mysheet.Evaluate("Match(1,(" & hrange.Address & "=" & HI &

")*("
& mrange.Address & "=" & mode & "),0)")

ElseIf HI 0 And HI < Application.WorksheetFunction.Floor((Range("NB") /
2), 1) Then

nrow = mysheet.Evaluate("Match(1,(" & hrange.Address & "=" & HI &

")*("
& mrange.Address & "=" & mode & "*2),0)")

End If

ans = Application.WorksheetFunction.Index(mysheet.[3:65536], nrow, ncol +

1)
gather2 = ans
End Function

Thanks for any help!
Anna