excel macro to filter spreadsheet

Hello,

you could build a pivot table for each sheet, showing "Date GMT" and "GMT" in the row labels and the other columns in the Values area. Then click on a 4:00 time value in the pivot table, hold down Ctrl and click on a 16:00 time value. Righ-click and select Filter > "Keep only selected items".

See attached for the above applied to the EUR sheet, in a new sheet called EUR Filtered.

cheers, teylyn
Copy-of-TEST2.xlsx

Teylyn, thanks for that. It works but it is not what I need.

I need to build up seperate databases for each currency but only for the times 0400 and 1600. So each time the macro runs, it should copy the latest data into the relevant spreadsheet. i.e. EUR0400 and EUR1600.

Thanks

You can set the filter to include just one value, i.e. either 4:00 or 16:00. The pivot table can be set up with dynamic ranges as the source. The sheets with the pivot tables can be set up to automatically refresh when activated. If you want to pursue this avenue, I can provide the necessary tools.

This will be much more efficient, i.e. faster, than any VBA solution.

Is there a particular reason you need a macro that is slower than a pivot table? It might help if you could describe the bigger picture that explains the VBA requirement.

cheers, teylyn

Take the EUR as the example:

I have a macro that downloads the data through a DDE link into the Test2 spreadsheet. I only need the 0400 and 1600 data. Once I have those I can copy the latest rows into another spreadsheet which then calculates various studies for a trading system. It would be nice to have this automated so that I have one macro that:
1. downloads the main data
2. filters the 0400 and 1600 rows
3. copies them into another spreadsheet (EUR 0400)
4. copies again from EUR0400 to EURCalc
5. runs calculations
6. runs reports

I already have points 1&5&6 and I suppose point 3 could be omiitted but I am not an expert on VB and can only build step by step.  Does that make sense?

CC10, I'm about to turn in for the night and will be offline for a few days, but I've asked other experts to come have a look. I'm certain you will get a working solution very soon.

cheers, teylyn

thats very kind. Thanks.

This code copies the 04:00 and 16:00 rows to new worksheets.

Option Explicit

Public Sub Move400Data()
  Dim wksThing As Worksheet
  Dim intReply As VbMsgBoxResult
  Dim boolFound As Boolean
  Dim colNames As New Collection
  Dim vItem As Variant
  Dim rngFiltered As Range
  Dim rngCriteria As Range
  boolFound = False
  For Each wksThing In ActiveWorkbook.Worksheets
    If wksThing.Name Like "*0400*" Then
      colNames.Add wksThing.Name
      boolFound = True
    End If
  Next
  If boolFound Then
    intReply = MsgBox("Destination worksheets found.  Ok to overwrite?", vbOKCancel, "Overwrite prompt")
    If intReply = vbCancel Then
      Exit Sub
    Else
      'remove existing destination worksheets
      For Each vItem In colNames
        ActiveWorkbook.Worksheets(CStr(vItem)).Delete
      Next
    End If
  End If
  Set colNames = New Collection
  For Each wksThing In ActiveWorkbook.Worksheets
    colNames.Add wksThing.Name
  Next
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Application.Calculation = xlCalculationManual
  
  'create destination worksheets
  For Each vItem In colNames
    Set wksThing = ActiveWorkbook.Worksheets.Add
    wksThing.Name = vItem & "0400"
  Next
  'create criteria sheet/range
  Set wksThing = ActiveWorkbook.Worksheets.Add()
  wksThing.Visible = xlSheetHidden
  Set rngCriteria = wksThing.Range("A1")
  rngCriteria.Value = "GMT"
  rngCriteria.Offset(1).Formula = "=time(4,0,0)"
  rngCriteria.Offset(2).Formula = "=time(16,0,0)"
  Set rngCriteria = wksThing.Range(rngCriteria, rngCriteria.End(xlDown))
  
  'move data
  For Each vItem In colNames
    Set wksThing = ActiveWorkbook.Worksheets(vItem)
    wksThing.Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, rngCriteria, Worksheets(wksThing.Name & "0400").Range("A1")
  Next
  
  'remove criteria worksheet
  rngCriteria.Worksheet.Delete
  
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  Application.Calculation = xlCalculationAutomatic
End Sub

Select allOpen in new window

I get a debug message on the following line:
wksThing.Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, rngCriteria, Worksheets(wksThing.Name & "0400").Range("A1")

Also it opens up 4 new worksheets but they are blank. Maybe it should be 04:00 rather than 0400?

I have included the workbook.

thanks,
Chris
Copy-of-Copy-of-TEST2-1.xlsm

That works fine now. Sorry for any confusion beforehand. Thanks for your help.
CC

You're welcome.

BTW...You can delete the following variable declaration statement.  It isn't used.

  Dim rngFiltered As Range

Select allOpen in new window

Thanks for taking over, aikimark!

@teylyn

No problem.  Hope you caught up on your beauty sleep.  Answering this question has renewed my interest in a couple of Excel articles, one of which has been on the to-finish list since last July.