Solved

macro with filter function to sort data with two variables

Posted on 2012-03-22
9
199 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
3 Use Cases for Connected Systems

Our Dev teams are like yours. They’re continually cranking out code for new features/bugs fixes, testing, deploying, testing some more, responding to production monitoring events and more. It’s complex. So, we thought you’d like to see what’s working for us.

 
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
 

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

DevOps Toolchain Recommendations

Read this Gartner Research Note and discover how your IT organization can automate and optimize DevOps processes using a toolchain architecture.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
VBA copy column paste as value 5 21
VLOOKUP 6 17
Excel highlight a cell based on input from another cell 3 14
Select Next Route by Time 4 19
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 code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

777 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