Wrox Programmer Forums

Need to download code?

View our list of code downloads.

Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
| Search | Today's Posts | Mark Forums Read
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
Reply
 
Thread Tools Search this Thread Display Modes
  #1 (permalink)  
Old July 30th, 2006, 06:24 PM
Authorized User
 
Join Date: Jul 2006
Location: Kalamazoo, MI, USA.
Posts: 27
Thanks: 0
Thanked 0 Times in 0 Posts
Default Multi-Column Array Search

Thanks for your help getting functions to work. While I can now define a function, I still am not getting my function to work. Basically I am trying to search a 4 column array, matching in the first 3 columns and returning the resulting 4th column. Here is my code:

Function PRMRate(RateTable As Range, ByVal Customer As String, Pickup As String, Drop As String)
    Dim a As Integer, TestCust As String, TestPickup As String, TestDrop As String
    'Get size of dataset
    lastrow = RateTable.Cells(1, 1).Value
    'Initialize return argument
    PRMRate = 0
    'Loop thru data for complete match of 3 fields
    For a = 3 To lastrow
        TestCust = RateTable.Cells(a, 1).Value
' Is This the Right Customer?
        If (Customer = TestCust) Then
' Is This the Right Pickup point for This Customer?
            TestPickup = RateTable.Cells(a, 2).Value
            If (Pickup = TestPickup) Then
' Is This the Right Drop Point for This Combination?
                TestDrop = RateTable.Cells(a, 3).Value
                    If (Drop = TestDrop) Then
' Yes - Set the Rate for This Combination
                    PRMRate = RateTable.Cells(a, 4).Value
                    Return
                    End If
            End If
        End If
    Next a
End Function

The range I am searching looks like this:

20
CustomerName PickupPoint DropPoint Rate
A C G 1
A C H 2
A C I 3
A D J 4
A D K 5
A D L 6
B E M 7
B E N 8
B E O 9
B F P 10
B F Q 11
B F R 12

It seems pretty simple, but then, too, I'm self-taught, so I'm pretty simple, too, and a novice in VBA. I start the search in the first column If I match in the first column, then I check the second column of the same row for a match. If that matches, then I check the third column of the same row for a match. If that matches, then I return the value in the fourth column of the same row as the function value. Where am I wrong? I get getting a #VALUE error

Thanks for any help anyone can give.
Reply With Quote
  #2 (permalink)  
Old July 31st, 2006, 10:47 AM
Authorized User
 
Join Date: Jul 2006
Location: , , Poland.
Posts: 23
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Hi,
I changed your function a bit and it works:

Function PRMRate(ByVal Customer As Variant, Pickup As Variant, Drop As Variant)
    Dim a As Integer, TestCust As Variant, TestPickup As Variant, TestDrop As Variant, LASTROW As Integer
    'Initialize return argument
    PRMRate = 0
    LASTROW = Cells(1, 1)
    'Loop thru data for complete match of 3 fields
    For a = 1 To LASTROW
        TestCust = Cells(a, 1).Value
' Is This the Right Customer?
        If (Customer = TestCust) Then
' Is This the Right Pickup point for This Customer?
            TestPickup = Cells(a, 2).Value
            If (Pickup = TestPickup) Then
' Is This the Right Drop Point for This Combination?
                TestDrop = Cells(a, 3).Value
                    If (Drop = TestDrop) Then
' Yes - Set the Rate for This Combination
                    PRMRate = Cells(a, 4).Value
                End If
            End If
        End If
    Next a
End Function

Reply With Quote
  #3 (permalink)  
Old July 31st, 2006, 07:52 PM
Authorized User
 
Join Date: Jul 2006
Location: Kalamazoo, MI, USA.
Posts: 27
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Thanks for helping, but you simplified a little too much. The range to be searched is actually is on a separate worksheet all by itself. In its final form, it may be a much as 8,000-9,000 rows long, and it is not available for casual viewing because it will contain proprietary info. I've tried different ways to identify the range in the function, but have had no success. Can anyone help? Here is my current attempt:

The function is invoked by PRMRate(CustomerName,PickupPoint,DropPoint). The 3 parameters are simply cells on the calling worksheet that contain text pulldown lists for each of the variables..

Option Explicit
Function PRMRate(Customer As Variant, Pickup As Variant, Drop As Variant)
    Dim a As Integer, TestCust As Variant, TestPickup As Variant, TestDrop As Variant
    Dim lastrow As Integer, RateRange As Range
' Initialize return argument
    PRMRate = 0
' Initialize Rate Sheet Array Reference
    Set RateRange = Worksheets("RateSheet").Range("CustomerRateSheet")
' Get size of dataset
    lastrow = RateRange.Cells(1, 1).Value
' Loop thru data for complete match of 3 fields
    For a = 3 To lastrow
        TestCust = RateRange.Cells(a, 1).Value
' Is This the Right Customer?
        If (Customer = TestCust) Then
' Is This the Right Pickup point for This Customer?
            TestPickup = RateRange.Cells(a, 2).Value
            If (Pickup = TestPickup) Then
' Is This the Right Drop Point for This Combination?
                TestDrop = RateRange.Cells(a, 3).Value
                    If (Drop = TestDrop) Then
' Yes - Set the Rate for This Combination
                    PRMRate = RateRange.Cells(a, 4).Value
                    Return
                    End If
            End If
        End If
    Next a
End Function
Reply With Quote
  #4 (permalink)  
Old August 1st, 2006, 02:40 AM
Authorized User
 
Join Date: Jul 2006
Location: , , Poland.
Posts: 23
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Hi,
If I understand well:
You have data (CustomerName,PickupPoint,DropPoint,Rate) in one worksheet ("RateSheet")and in Cell(1,1), in this sheet, You have information about qty of records (rows).Is it correct?
Additionally this sheet is not available for viewing (is it hidden or protected?).
Please explain me why do You need set RateRange. You can't use sheet name instead of RateRange?



Reply With Quote
  #5 (permalink)  
Old August 1st, 2006, 06:14 PM
Authorized User
 
Join Date: Jul 2006
Location: Kalamazoo, MI, USA.
Posts: 27
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Hi,

Thanks for responding. You are correct about the worksheet "RateSheet." I was doing Set RateRange to save keystrokes and to make it easier in the future should I need to change the worksheet name. Ideally, I would like to pass the name into the function, but that hasn't worked either. Any ideas? Her is the code with the Worksheet name RateSheet used:
Code:
Function PRMRate(Customer As Variant, Pickup As Variant, Drop As Variant)
    Dim a As Integer, TestCust As Variant, TestPickup As Variant, TestDrop As Variant
    Dim lastrow As Integer, RateRange As Range
' Initialize return argument
    PRMRate = 0
' Get size of dataset
    lastrow = Worksheets("RateSheet").Cells(1, 1).Value
' Loop thru data for complete match of 3 fields
    For a = 3 To lastrow
        TestCust = Worksheets("RateSheet").Cells(a, 1).Value
' Is This the Right Customer?
        If (Customer = TestCust) Then
' Is This the Right Pickup point for This Customer?
            TestPickup = Worksheets("RateSheet").Cells(a, 2).Value
            If (Pickup = TestPickup) Then
' Is This the Right Drop Point for This Combination?
                TestDrop = Worksheets("RateSheet").Cells(a, 3).Value
                    If (Drop = TestDrop) Then
' Yes - Set the Rate for This Combination
                    PRMRate = Worksheets("RateSheet").Cells(a, 4).Value
                    Return
                    End If
            End If
        End If
    Next a
End Function
Terry
Reply With Quote
  #6 (permalink)  
Old August 1st, 2006, 06:45 PM
Authorized User
 
Join Date: Jul 2006
Location: , , Poland.
Posts: 23
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Hi,
Change Return on Exit Function

Kazik

Reply With Quote
Reply


Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Trackbacks are Off
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Multi column search and compare luxcs Excel VBA 1 November 16th, 2006 02:45 PM
resizeable multi-dimensional array 132591 C++ Programming 2 October 20th, 2006 05:07 PM
DataGrid Multi-Column pbyrum Classic ASP Professional 4 October 5th, 2005 06:02 PM
multi-column combo myth12345 VB How-To 1 January 3rd, 2005 04:29 PM
Search on multi tables mani_he Pro PHP 4 November 23rd, 2004 09:07 PM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.