Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

macro with filter function to sort data with two variables

Posted on 2012-03-22
9
Medium Priority
?
206 Views
Last Modified: 2012-03-23
In sheet 1 you will see that I add a number of rows to the database at certain times. I need a macro that sorts the sheet by currency pair (column H)) and then by date(column Q).
Then it should copy the cell (J,lastrow) to the relevant cell in sheet 2.
I tried to do this using Vlookup but that didn't work as there are many rows with no data, so I thought a macro would be better.
The macro should then loop through the six currency pairs.

Thanks,
Chris
ExampleOfDatabase.xlsx
0
Comment
Question by:CC10
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 4
9 Comments
 
LVL 3

Expert Comment

by:Frank White
ID: 37753242
Is all the sorting part of the goal (i.e. you want the data presented that way for ease of navigation/reading), or is the actual goal only to get the latest currency rate for each currency pair?

There are ways to get the latter without doing all the sorting, which is why I'm asking whether you want both or if you only thought sorting was necessary to get to that value.
0
 

Author Comment

by:CC10
ID: 37753574
No the sorting is not relevant. All I am trying to get are the order rates in column J. In the example for EURUSD it would be J129.

If I were to add a set of new rows, if the order rate has been changed, it would show up with a new date. That is why the criteria should be the currency pair (EURUSD) and the latest date, and that should be linked either with a formula or copied with a macro to Sheet 2, B3 (for the EURUSD) and so on...
0
 
LVL 42

Accepted Solution

by:
dlmille earned 1600 total points
ID: 37756150
There are actually 8 currency pairs in your data.  The app clears the output sheet (sheet2 in this example, which you can change) and then uses a dictionary to capture the pairs, as existing pairs are found at different dates, the latest date is stored, until the entire sheet is processed.  Then, the output is generated on sheet 2.

With sorting, your source data gets a bit messed up, tho the coding is potentially a bit shorter, however with the below code, you can add additional conditions more easily than trying to rewrite sorts, etc...

E.g., do you need to be concerned with Cancelled or Accepted, etc., when capturing the data?

Here's the code:
Option Explicit
Type myCurrency
    rowFound As Range
    fromTo As String
    exchDate As Date
End Type
Sub getLatestCurrencyPairs()
Dim wkb As Workbook
Dim wks As Worksheet
Dim wksOut As Worksheet
Dim r As Range
Dim rng As Range
Dim myDict As Dictionary
Dim curCheck() As myCurrency
Dim fromTo As String
Dim exchDate As Date
Dim vPairs As Variant
Dim i As Long
Dim j As Long

    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("Sheet1") '<- change to suit
    Set wksOut = wkb.Sheets("Sheet2") '<- change to suit
    
    'clear output
    wksOut.Cells.Clear
    With wksOut.Range("A1:Q1")
        .Value = wks.Range("A2:Q2").Value
        .Font.Bold = True
    End With
    
    Set myDict = CreateObject("Scripting.Dictionary") '<for unique values
    
    For Each r In wks.Range("A2", wks.Range("A" & wks.Rows.Count).End(xlUp))
        If r.Value <> vbNullString And IsDate(r.Offset(0, 16).Value) Then
            fromTo = r.Offset(0, 7).Value
            exchDate = r.Offset(0, 16).Value
            If Not myDict.exists(fromTo) Then
                myDict.Add Key:=fromTo, Item:=i
                ReDim Preserve curCheck(i) As myCurrency
                curCheck(i).fromTo = fromTo
                curCheck(i).exchDate = exchDate
                Set curCheck(i).rowFound = r
                i = i + 1
                Debug.Print curCheck(i - 1).fromTo & " at " & r.Row
            Else
                j = myDict(fromTo)
                If exchDate > curCheck(j).exchDate Then 'found exchange at a later date, so get the latest data
                    curCheck(j).exchDate = exchDate
                    Set curCheck(j).rowFound = r
                    Debug.Print curCheck(j).fromTo & " at "; r.Row
                End If
            End If
        End If
    Next r
    
    'now generate output
    If Not myDict Is Nothing Then
        For i = LBound(curCheck) To UBound(curCheck)
            wksOut.Range("A2").Offset(i, 0).Resize(1, Columns("A:Q").Columns.Count).Value = curCheck(i).rowFound.Resize(1, Columns("A:Q").Columns.Count).Value
        Next i
    End If
    
gracefulExit:

    myDict.RemoveAll
    Set myDict = Nothing
    Erase curCheck
    
    MsgBox "Process Complete! Hit Enter to see results", vbOKOnly, "Success!"
    wksOut.Activate
End Sub

Open in new window


See attached demonstration workbook.

Enjoy!

Dave
ExampleOfDatabase-r1.xlsm
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 42

Expert Comment

by:dlmille
ID: 37756176
I say with a very big smile, doing this with formulas is a bit more efficient.  In Sheet 3 I give you a table of output where you can enter new pairs in column A and copy down the formulas.

The formula (with Pair in Column A for the lookups):

[A2]=INDEX(Sheet1!A$1:A$5000,MATCH($A2&MAX(IF(INDEX(Sheet1!$H$1:$Q$5000,,1)=$A2,Sheet1!$Q$1:$Q$5000,0)),Sheet1!$H$1:$H$5000&Sheet1!$Q$1:$Q$5000,0))

Confirmed with CTRL+SHIFT+ENTER and copied down/across as needed to replicate the source sheet, but just for the pair/latest date combination.  Works for the first 5000 rows of data so adjust as necessary.  This is an array formula so after hitting the CTRL+SHIFT+ENTER, you'll see curly braces around the formula.

See revised workbook.  this table is on sheet 3.

Cheers,

Dave
ExampleOfDatabase-r3.xlsm
0
 

Author Closing Comment

by:CC10
ID: 37756239
Perfect!  Thanks very much for your help.

Chris
0
 

Author Comment

by:CC10
ID: 37756387
Yes, the formulas work just as well.

I have one question, when I copied the VB script into my original workbook and try to run the macro, I get a compile error: User -defined type not defined at
Dim myDict As Dictionary
0
 
LVL 42

Expert Comment

by:dlmille
ID: 37756388
You'd have to add the reference library.

Instead, change line 13 to:

Dim myDict as Object

And you should be good to go.

Dave
0
 

Author Comment

by:CC10
ID: 37756425
Thanks again, all works now. Really very helpful.
0
 
LVL 42

Expert Comment

by:dlmille
ID: 37756428
Remember, you have inifinite points, so ask as many questions as you need.

Cheers,

Dave
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

670 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question