Common Dates. Is this possible?

  • Thread starter Thread starter shapper
  • Start date Start date
S

shapper

Hello,

I have 3 time series on a excel worksheed (EurUsd, Euribor and Dow).
Each time series has two columns: Values and Date. This is daily data.

The problem is that for one I have 800 values, for other 820 and for
the other 810.
This is normal. In some days a market can be closed while the other is
open.

Is it possible to select only the values where all the markets are
open?

Basically I need to create 4 columns:

Date, EurUsd Value, Euribor Value and Dow Value

Only for the dates where all markets are open, so an intersection by
date.

I need to do this only once.

Thanks,
Miguel
 
i wood do an autofilter. pick >0 for criteria for each column.

| Hello,
|
| I have 3 time series on a excel worksheed (EurUsd, Euribor and Dow).
| Each time series has two columns: Values and Date. This is daily data.
|
| The problem is that for one I have 800 values, for other 820 and for
| the other 810.
| This is normal. In some days a market can be closed while the other is
| open.
|
| Is it possible to select only the values where all the markets are
| open?
|
| Basically I need to create 4 columns:
|
| Date, EurUsd Value, Euribor Value and Dow Value
|
| Only for the dates where all markets are open, so an intersection by
| date.
|
| I need to do this only once.
|
| Thanks,
| Miguel
 
i wood do an autofilter.  pick >0 for criteria for each column.


| Hello,
|
| I have 3 time series on a excel worksheed (EurUsd, Euribor and Dow).
| Each time series has two columns: Values and Date. This is daily data.
|
| The problem is that for one I have 800 values, for other 820 and for
| the other 810.
| This is normal. In some days a market can be closed while the other is
| open.
|
| Is it possible to select only the values where all the markets are
| open?
|
| Basically I need to create 4 columns:
|
| Date, EurUsd Value, Euribor Value and Dow Value
|
| Only for the dates where all markets are open, so an intersection by
| date.
|
| I need to do this only once.
|
| Thanks,
| Miguel
Click to expand...

I am not sure if I understood you but for each time series I have two
columns: Date and Value.

So the two columns for EURUSD starts at row 2 and finishes at row 800.
The two columns for Dow, because it has less values, starts at row 2
and finishes at row 780.
However I don't have empty rows on any of the time series.
The ones that has less values finishes on a lower row index.
 
Copy the code below into a standard module. The call it with a command button.

Hope this helps! If so, click "YES" below.

Option Explicit

Sub OrganizeMarkets()

Dim rngEurUsed As Range
Dim rngEuriBor As Range
Dim rngDow As Range
Dim colRanges As Collection
Dim lngFirstRow As Long
Dim lngLastRow As Long
Dim rngMaster As Range
Dim rng As Range
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim i As Long

' set date ranges
With Sheets("Sheet1")
Set rngEurUsed = .Range("A3:A" & .Cells(Rows.Count,
"A").End(xlUp).Row)
Set rngEuriBor = .Range("C3:C" & .Cells(Rows.Count,
"C").End(xlUp).Row)
Set rngDow = .Range("E3:E" & .Cells(Rows.Count, "E").End(xlUp).Row)
End With

Set colRanges = New Collection
With colRanges
.Add rngEurUsed
.Add rngEuriBor
.Add rngDow
End With

With Sheets("Sheet2")

' make master date range in sheet2
lngFirstRow = 2
lngLastRow = 1
For Each rng In colRanges
lngLastRow = lngLastRow + rng.Rows.Count
.Range(.Cells(lngFirstRow, "A"), .Cells(lngLastRow, "A")).Value
= rng.Value
lngFirstRow = lngLastRow + 1
Next rng

' remove duplicates from master date range
Set rngMaster = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
rngMaster.AdvancedFilter xlFilterInPlace, Unique:=True

End With

' scan for dates in EurUsed range and match with other ranges
For Each rng In rngMaster

' ensure it is a date
If IsDate(rng.Value) Then

' find date in rngEuriBor
Set r1 = rngEurUsed.Find(What:=rng.Text, _
After:=rngEurUsed.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True, _
SearchFormat:=False)

' if date is found, find date in rngEuriBor
If Not r1 Is Nothing Then

Set r2 = rngEuriBor.Find(What:=rng.Text, _
After:=rngEuriBor.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True, _
SearchFormat:=False)

End If

' if date is found, find date in rngDow
If Not r2 Is Nothing Then

Set r3 = rngDow.Find(What:=rng.Text, _
After:=rngDow.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True, _
SearchFormat:=False)
End If

' if date is found, paste values in master list
If Not r1 Is Nothing And Not r2 Is Nothing And Not r3 Is Nothing
Then
With rng
.Offset(0, 1).Value = r1.Offset(0, 1).Value ' EurUsed
value
.Offset(0, 2).Value = r2.Offset(0, 1).Value ' EuriBor
value
.Offset(0, 3).Value = r3.Offset(0, 1).Value ' Dow value
End With
End If
End If
Next rng

' remove all empty rows
With Sheets("Sheet2")
For i = lngFirstRow To lngLastRow Step -1
If IsEmpty(.Cells(i, "B")) Then
.Rows(i).Delete Shift:=xlUp
End If
Next i
End With

End Sub
 
Copy the code below into a standard module.  The call it with a commandbutton.

Hope this helps! If so, click "YES" below.

Option Explicit

Sub OrganizeMarkets()

Dim rngEurUsed As Range
Dim rngEuriBor As Range
Dim rngDow As Range
Dim colRanges As Collection
Dim lngFirstRow As Long
Dim lngLastRow As Long
Dim rngMaster As Range
Dim rng As Range
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim i As Long

    ' set date ranges
    With Sheets("Sheet1")
        Set rngEurUsed = .Range("A3:A" & .Cells(Rows.Count,
"A").End(xlUp).Row)
        Set rngEuriBor = .Range("C3:C" & .Cells(Rows.Count,
"C").End(xlUp).Row)
        Set rngDow = .Range("E3:E" & .Cells(Rows.Count, "E").End(xlUp).Row)
    End With

    Set colRanges = New Collection
        With colRanges
            .Add rngEurUsed
            .Add rngEuriBor
            .Add rngDow
        End With

    With Sheets("Sheet2")

        ' make master date range in sheet2
        lngFirstRow = 2
        lngLastRow = 1
        For Each rng In colRanges
            lngLastRow = lngLastRow + rng.Rows.Count
            .Range(.Cells(lngFirstRow, "A"), .Cells(lngLastRow, "A")).Value
= rng.Value
            lngFirstRow = lngLastRow + 1
        Next rng

        ' remove duplicates from master date range
        Set rngMaster = .Range("A2:A" & .Cells(Rows.Count, "A")..End(xlUp).Row)
        rngMaster.AdvancedFilter xlFilterInPlace, Unique:=True

    End With

    ' scan for dates in EurUsed range and match with other ranges
    For Each rng In rngMaster

        ' ensure it is a date
        If IsDate(rng.Value) Then

            ' find date in rngEuriBor
            Set r1 = rngEurUsed.Find(What:=rng.Text, _
                                    After:=rngEurUsed.Cells(1, 1), _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=True, _
                                    SearchFormat:=False)

            ' if date is found, find date in rngEuriBor
            If Not r1 Is Nothing Then

                Set r2 = rngEuriBor.Find(What:=rng.Text, _
                                    After:=rngEuriBor.Cells(1, 1), _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=True, _
                                    SearchFormat:=False)

            End If

            ' if date is found, find date in rngDow
            If Not r2 Is Nothing Then

                Set r3 = rngDow.Find(What:=rng.Text, _
                                    After:=rngDow.Cells(1, 1), _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=True, _
                                    SearchFormat:=False)
            End If

            ' if date is found, paste values in master list
            If Not r1 Is Nothing And Not r2 Is Nothing And Not r3 Is Nothing
Then
                With rng
                    .Offset(0, 1).Value = r1.Offset(0, 1).Value  ' EurUsed
value
                    .Offset(0, 2).Value = r2.Offset(0, 1).Value  ' EuriBor
value
                    .Offset(0, 3).Value = r3.Offset(0, 1).Value  ' Dow value
                End With
            End If
        End If
    Next rng

    ' remove all empty rows
    With Sheets("Sheet2")
        For i = lngFirstRow To lngLastRow Step -1
            If IsEmpty(.Cells(i, "B")) Then
                .Rows(i).Delete Shift:=xlUp
            End If
        Next i
    End With

End Sub
Click to expand...

Hello,

I have been trying your code but it does not seem to work.
I get all values in Sheet2 in a column and each section has much less
values than the original.

I have my excel file here:
http://www.flyondreams.net/Data.xlsm

It contains the data and the code.

Could someone please check what I am doing wrong?

Thanks,
Miguel
 
Hello,

I have been trying your code but it does not seem to work.
I get all values in Sheet2 in a column and each section has much less
values than the original.

I have my excel file here:http://www.flyondreams.net/Data.xlsm

It contains the data and the code.

Could someone please check what I am doing wrong?

Thanks,
Miguel
Click to expand...

Please, anyone?

Thank You,
Miguel
 
Back
Top