match multiple criteria using VBA
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 |
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 |
All times are GMT +1. The time now is 09:50 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com