Consulting

Results 1 to 5 of 5

Thread: VBA code for multiple column loop - help please!!!

  1. #1
    VBAX Newbie
    Joined
    Feb 2017
    Posts
    1
    Location

    VBA code for multiple column loop - help please!!!

    Hi everyone,

    I'm new to the forum, and I have a problem in VBA that I cant seem solve!!!

    To explain, I am having problem with the VBA code for multiple lookups. I have three columns in a worksheet. The first column contains a list of dates and the second column contains a list of product codes. I am trying to populate the third column with the price of the product.
    In a different worksheet I have three columns, which are the dates, product codes, and the prices for each of the products. The issue is the price of the product changes each year for each product, so I need to find the price on or after the date is updated for each product. I have attached the two sheets as example if it helps, can someone please help with the VBA for this example, thanks
    Attached Files Attached Files

  2. #2
    VBAX Regular JBeaucaire's Avatar
    Joined
    Sep 2014
    Location
    Bakersfield
    Posts
    32
    Location
    Here is a custom function you can use on your sheet as long as the lookup table is in the exact format you showed...

    A = dates
    B = codes
    C = historical prices

    Those three columns can exist anywhere, but in that order, the array in the function evaluates them in that order.

    The the function is used in a cell as:

    =NEWESTPRICE(CurrentDate, ProductCode, DateCodeTable)

    =NEWESTPRICE(A3, B3, Sheet2!$A$2:$C$12)


    Option Explicit
    Function NEWESTPRICE(CurrentDate As Date, ProductCode As String, DateCodeTable As Range) As Double
    Dim d As Long, Newest As Date
    Dim dcARR As Variant
    
    dcARR = DateCodeTable.Value
    For d = 1 To UBound(dcARR)
        If dcARR(d, 2) = ProductCode Then
            If Newest = 0 Then
                Newest = dcARR(d, 1)
                NEWESTPRICE = dcARR(d, 3)
            ElseIf dcARR(d, 1) > Newest Then
                Newest = dcARR(d, 1)
                NEWESTPRICE = dcARR(d, 3)
            End If
        End If
    Next d
    End Function
    Attached Files Attached Files
    Microsoft MVP 2010 - Excel
    Visit: Jerry Beaucaire's Excel Files & Macros

    “None of us is as good as all of us” - Ray Kroc
    “Actually, I *am* a rocket scientist.” - JB (little ones count!)

  3. #3
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,875
    Adapting JBeaucaire's code (only because I'm wondering whether the OP was looking for the newest price):
    Function PriceAtTheTime(CurrentDate As Date, ProductCode As String, DateCodeTable As Range) As Double
    Dim dcARR, maxDate As Date, d As Long
    dcARR = DateCodeTable.Value
    For d = 1 To UBound(dcARR)
      If dcARR(d, 2) = ProductCode And dcARR(d, 1) <= CurrentDate Then
        If dcARR(d, 1) > maxDate Then
          PriceAtTheTime = dcARR(d, 3)
          maxDate = dcARR(d, 1)
        End If
      End If
    Next d
    End Function
    Use:
    =PriceAtTheTime(CurrentDate, ProductCode, DateCodeTable)

    =PriceAtTheTime(A2, B2, Sheet2!$A$1:$C$12)
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  4. #4
    VBAX Regular JBeaucaire's Avatar
    Joined
    Sep 2014
    Location
    Bakersfield
    Posts
    32
    Location
    Quote Originally Posted by p45cal View Post
    Adapting JBeaucaire's code (only because I'm wondering whether the OP was looking for the newest price)
    THat's a great distinction! Mine gives the most current price for any item regardless of where it occurs in the table, yours gives the price that was in effect on the date given, very nice.
    Microsoft MVP 2010 - Excel
    Visit: Jerry Beaucaire's Excel Files & Macros

    “None of us is as good as all of us” - Ray Kroc
    “Actually, I *am* a rocket scientist.” - JB (little ones count!)

  5. #5
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,875
    Now all we need is for Hub to have the grace to acknowledge the help he's had - unlikely since he cross posted this question and got a solution which, it seems, he paid for!

    http://stackoverflow.com/questions/4...ltiple-matches
    https://www.freelancer.ca/projects/S...code-13121470/

    Some reading for Hub: http://www.excelguru.ca/content.php?184

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •