Solved

macro with filter function to sort data with two variables

Posted on 2012-03-22
9
198 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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Excel - list cell contents that are not duplicated 4 30
Excel VBA When using VLookup 6 28
Excel Save As Status Box will not go away 6 19
MS Excel IF AND OR statement 3 28
Sparklines have been introduced with Excel 2010 and are a useful tool for creating small in-cell charts, used for example in dashboards. Excel 2010 offers three different types of Sparklines: Line, Column and Win/Loss. What it does not offer is a…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …

895 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

17 Experts available now in Live!

Get 1:1 Help Now