Solved

macro with filter function to sort data with two variables

Posted on 2012-03-22
9
197 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
  • 4
  • 4
9 Comments
 
LVL 3

Expert Comment

by:DaFranker
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 41

Accepted Solution

by:
dlmille earned 400 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
 
LVL 41

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
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 

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 41

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 41

Expert Comment

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

Cheers,

Dave
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Drop Down List with Unique/Distinct Values (enhancing the Combo-Box with a few steps and a little code) David miller (dlmille) Intro Have you ever created a data validation list from a database field or spreadsheet column (e.g., Zip Codes or Co…
Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
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…

747 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now