On Dec 15, 8:31*pm, Ryan H <Ry...@discussions.microsoft.com> wrote:
> 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
>
> --
> Cheers,
> Ryan
>
> "shapper" wrote:
> > On Dec 15, 6:02 pm, "Homey" <none> wrote:
> > > i wood do an autofilter. *pick >0 for criteria for each column.
>
> > > "shapper" <mdmo...@gmail.com> wrote in message
>
> > >news:debb56c8-644f-4ba0-9ce5-(E-Mail Removed)....
> > > | 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 otheris
> > > | 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 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.
> > .
>
>
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
Similar Threads
