Posts by filo65

filo65 · Mar 25th 2008

Re: VBA code to merge Worksheets Of Up To 1 Million Records In Ex. 2007

Tiberius,

you should definetly move to Access or Oracle for this kind of experiments!

Filippo

filo65 · Oct 17th 2007

Re: Pass Element Of User-Defined Data Type

Does something like this work for you?

Code

Option Explicit


Type strA
  abc() As Long
  def() As String
End Type


Type strB
  poi As Double
  qwe As Variant
End Type


Sub mainTest()
  Dim i&, imax&, j&, jmax&
  Dim A As strA, Bvec() As strB
  
  imax = 5: jmax = 3
  
  With A
    ReDim .abc(imax), A.def(jmax)
    For i = 0 To imax Step 1
      .abc(i) = 10 + i
      Call myfunc(.abc(i))
    Next i
    
    ReDim .def(jmax)
    For j = 0 To jmax Step 1
      .def(j) = (j + 5) * 200 & " S - F "
      Call myfunc(.def(j))
    Next j
  End With
  
  jmax = 2
  ReDim Bvec(jmax)
  For j = 0 To jmax Step 1
    Bvec(j).poi = Rnd
    Call myfunc(Bvec(j).poi)
  Next j
  Bvec(0).qwe = "Hallo"
  Call myfunc(Bvec(0).qwe)
  Bvec(1).qwe = 0.5555
  Call myfunc(Bvec(1).qwe)
  Bvec(2).qwe = 1000
  Call myfunc(Bvec(2).qwe)
  
End Sub


Private Sub myfunc(val_1 As Variant)
  Debug.Print val_1
End Sub

Display More

filippo

filo65 · Sep 25th 2007

Re: Vlookup Causing Slow Calculations

Dave,

Quote

Native Excel Functions are ALWAYS much faster than a replacement Custom Function

I don't agree with you; certainly they are more practical because they save you plenty of typing, but please take a look at this example:

Code

Sub excelfunction_test()
  Dim i&, imax&
  Dim tim#, tmp#
  imax = 5000000
  
  tim = Now
  tmp = 0
  
  For i = 1 To imax Step 1
    tmp = d_min(tmp, i)
  Next i
  
  Cells(1, 1) = "Custom"
  Cells(1, 2) = Format(Now - tim, "hh:mm:ss")
  
  
  tim = Now
  tmp = 0
  
  For i = 1 To imax Step 1
    tmp = WorksheetFunction.Min(tmp, i)
  Next i
  
  Cells(3, 1) = "Excel Built-in"
  Cells(3, 2) = Format(Now - tim, "hh:mm:ss")
  
End Sub


Private Function d_min(a, b)
  If a < b Then d_min = a Else d_min = b
End Function

Display More

Custom vs Built-in: 14:1 Speed gain.

filippo

filo65 · Aug 27th 2007

Re: Vba Code To Enter Formula

angshuman,

probably it is faster entering the formula without loop ( if you enter only twice ).

anyway try:

Code

Sub Do_It() 
    ActiveCell.Value = "=If(ISERROR(INDIRECT("& cells(i,j) &"!F:F"")),0,  COUNTIF(INDIRECT("& cells(i,j) &""!F:F""),""A""))" 
End Sub

filippo

filo65 · Aug 27th 2007

Re: Calculate Future Date Excluding Weekends

glad to be helpful!!

filippo

filo65 · Aug 27th 2007

Re: Calculate Future Date Excluding Weekends

potain,

maybe I missed something, but can't you use "workday(...,... )" in your vbe? You must set the reference to ATPVBAEN.XLA

filippo

filo65 · Aug 22nd 2007

Often it is necessary to reserve one or more columns to holiday lists, and afterward one has to maintain them and keep them up-to-date or delete the past ones. When this has to be done on more than one spreadsheet can became a pretty unpleasant task.

Here is a fast way to get the official holidays calculated from now ( actually from 1900 ) to 2500, including managing week-ends.

The concept is pretty easy and works for any country even if with some changes :

FORGET the year for the moment. Holiday fall on a specific calendar day ( Jan. 1st, Dec. 25th ) or on a specific day of the week ( President and Martin L King's day, etc. ); and we have to make the whole more tasteful some exception.

Let's take for example:
- Jan. 1: we can see it as 1 ( Jan. ) * 100 + 01 = 101;
- Dec. 25: we can see it as 12 ( Dec. ) * 100 + 25 = 1225.

indipendently from the year we can find out immediately if today is holiday or not; exception if 1225 is saturday or sunday ), etc.

now consider Martin L King or Easter day:
- MLK falls the third Monday in January but alway between Jan. 15 and Jan 22; that means
between 115 and 122;
- Easter ( here you need the year ) falls always on a Sunday between Mar. 3rd ( 322 ) and Apr. 25 ( 425 ) - Why? please refer to Wikipedia.

The only "complex" part is the calculation of Easter ( I use the Gaussian formula ), afterward is just a question of checking if conditions are met.

The code I propose is written for my own pourpose ( I need the Financial Market - not stock exchange - good business days ), for EUR and USD; anyone can easily adapt it to his own need.

Code

Option Explicit


'==========================================
'
' Calculate Gaussian easter day
'
'==========================================


Function rv_Easter(yyyy&)
  Dim a&, b&, c&, d&, e&, M&, N&, tmp&
  Select Case yyyy
    Case 1900 To 2099
      M = 24:      N = 5
    Case 2100 To 2199
      M = 24:      N = 6
    Case 2200 To 2299
      M = 25:      N = 0
    Case 2300 To 2399
      M = 26:      N = 1
    Case 2400 To 2499
      M = 24:      N = 1
  End Select


  a = yyyy Mod 19:      b = yyyy Mod 4:     c = yyyy Mod 7
  d = (19 * a + M) Mod 30:      e = (2 * b + 4 * c + 6 * d + N) Mod 7:    tmp = d + e


  If tmp < 10 Then
    rv_Easter = DateSerial(yyyy, 3, tmp + 22):    Exit Function
  Else
    tmp = tmp - 9
    If tmp = 26 Then
      rv_Easter = DateSerial(yyyy, 4, 19):      Exit Function
    ElseIf tmp = 25 And d = 28 And e = 6 And a > 10 Then
      rv_Easter = DateSerial(yyyy, 4, 18):      Exit Function
    Else
      rv_Easter = DateSerial(yyyy, 4, tmp):     Exit Function
    End If
  End If
End Function


'==========================================
'
' check if the day is a good business day
'
'==========================================


Function isGoodBusinessDay(i_date As Date, Optional curr$ = "EUR") As Boolean
  Select Case Weekday(i_date)
    Case 1, 7
      isGoodBusinessDay = False
    Case Else
      Select Case curr
        Case "USD"
          isGoodBusinessDay = calendar_USD(i_date)
        Case Else
          isGoodBusinessDay = calendar_EUR(i_date)
      End Select
  End Select
End Function


'==============================================
'
' official market holidays in EUR Area
'
'==============================================


Private Function calendar_EUR(i_date As Date) As Boolean
  Dim ISO_datum&, ISO_easter_&, easter_ As Date
  
  ISO_datum& = Month(i_date) * 100 + Day(i_date)


  Select Case ISO_datum
    Case 101, 501, 1225, 1226, 1231
      calendar_EUR = False
      Exit Function
    ' if date is between Holy Friday and Easter Monday
    Case 322 To 425
      easter_ = rv_Easter(Year(i_date))
      ISO_easter_ = Month(easter_) * 100 + Day(easter_)
      Select Case ISO_datum
        Case ISO_easter_ - 2 To ISO_easter_ + 1
          calendar_EUR = False
          Exit Function
      End Select
  End Select
  calendar_EUR = True
End Function


'==============================================
'
' official market holidays in USD Area
'
'==============================================


Private Function calendar_USD(i_date As Date) As Boolean
  Dim ISO_datum&, wk&, ISO_easter_&, easter_ As Date
  
  ISO_datum& = Month(i_date) * 100 + Day(i_date)
  wk = Weekday(i_date)
  
  If wk = 2 Then  ' if it's Monday
    Select Case ISO_datum
      Case 102, 705, 1226
        calendar_USD = False
        Exit Function
      Case 115 To 121   ' Martin Luther King day  ( it falls on 3rd Monday )
        calendar_USD = False
        Exit Function
      Case 215 To 221   ' President's day   ( it falls on 3rd Monday )
        calendar_USD = False
        Exit Function
      Case 525 To 531   ' Memorial day   ( it falls on last Monday )
        calendar_USD = False
        Exit Function
      Case 901 To 907   ' Labor day   ( it falls on first Monday )
        calendar_USD = False
        Exit Function
      Case 1008 To 1014 ' Columbus day  ( it falls on second Monday )
        calendar_USD = False
        Exit Function
    End Select
  End If
  
  Select Case ISO_datum
    Case 101, 704, 1012, 1225
      calendar_USD = False
      Exit Function
    Case 322 To 425
      easter_ = rv_Easter(Year(i_date))
      ISO_easter_ = Month(easter_) * 100 + Day(easter_)
      Select Case ISO_datum
        Case ISO_easter_ - 2 To ISO_easter_
          calendar_USD = False
          Exit Function
      End Select
    Case 1122 To 1128  ' Thanksgiving   ( 4th Thursday )
      If wk = 5 Then calendar_USD = False:      Exit Function
    Case 1224       ' if it's Friday
      If wk = 6 Then calendar_USD = False:     Exit Function
  End Select
  calendar_USD = True
End Function




'==========================================
'
' Calculate Gaussian easter day
'
'==========================================


Function rv_Easter(yyyy&)
  Dim a&, b&, c&, d&, e&, M&, N&, tmp&
  Select Case yyyy
    Case 1900 To 2099
      M = 24:      N = 5
    Case 2100 To 2199
      M = 24:      N = 6
    Case 2200 To 2299
      M = 25:      N = 0
    Case 2300 To 2399
      M = 26:      N = 1
    Case 2400 To 2499
      M = 24:      N = 1
  End Select


  a = yyyy Mod 19:      b = yyyy Mod 4:     c = yyyy Mod 7
  d = (19 * a + M) Mod 30:      e = (2 * b + 4 * c + 6 * d + N) Mod 7:    tmp = d + e


  If tmp < 10 Then
    rv_Easter = DateSerial(yyyy, 3, tmp + 22):    Exit Function
  Else
    tmp = tmp - 9
    If tmp = 26 Then
      rv_Easter = DateSerial(yyyy, 4, 19):      Exit Function
    ElseIf tmp = 25 And d = 28 And e = 6 And a > 10 Then
      rv_Easter = DateSerial(yyyy, 4, 18):      Exit Function
    Else
      rv_Easter = DateSerial(yyyy, 4, tmp):     Exit Function
    End If
  End If
End Function

Display More

filippo

filo65 · Aug 15th 2007

Re: UDF Recalculating Prematurely

if you need the EUR Area official market holidays, that is pretty simple to calculate and probably faster then lookup a whole vector.

In total are 5 fixed days plus 4 variables ( around easter )

USD Area maybe sligthly complex because of some more variable dates but still faster than vectors.

filippo

filo65 · Jul 31st 2007

Re: YEARFRAC & Leap Years

Thanks guys!

it's probably true that 'Yearfrac' work just for period below/equal to one year. What is misleading is that it works for all date constellations for all method but Act/Act.

filippo

filo65 · Jul 30th 2007

It looks like a pretty silly problem but it's driving me mad.

The yearfrac function takes a two dates and a basis. Now assume basis = 1 ( Act / Act ) and two cases:

1) 06-Jan-06 -> 06-Jan-08 ( 730 days ) = 1.998175182 =>> divisor = 730/1.998175182 = 365.33333

2) 06-Jan-05 -> 06-Jan-07 ( 730 days ) = 2 =>> divisor = 730/2 = 365

In case 1) 2008 is a leap year ( but the "leap" has yet to come! ). Can anyone explain me the logic behind? I suppose the extra day is divided by 3 but where is the "Actuality" of the divisor?

Filippo

filo65 · Jul 3rd 2007

Re: Optimize VBA Code

It would be good if you would post a zipped file to have overall view.

filippo

filo65 · Jun 29th 2007

Re: Optimize VBA Code

ambarrovecchio,

I changed a little bit your code; not sure everything works fine, because I don't have any possibility to check it. I think shouldn't be any problem to correct evtl error messages

Code

Sub SalesCostOfSales()
     '
     ' SalesCostOfSales Macro
     ' Macro created by Anthony Barrovecchio
     '
    Application.ScreenUpdating = False
     
    ActiveSheet.Name = "Sheet1"
     
     'Fills product codes in the blank cells'
    lastrow = Range("G65536").End(xlUp).Row
    With Range("C6:C" & lastrow)
        On Error Resume Next
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
        On Error GoTo 0
        .Value = .Value
    End With
     
     'Sorts by function code, then product code, then margin %'
    lastrow = Range("G65536").End(xlUp).Row
    Range("A" & lastrow).Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("C2") _
    , Order2:=xlAscending, Key3:=Range("G2"), Order3:=xlAscending, Header:= _
    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
    xlSortNormal
     
     'Creates table for margin limits and names it'
    Sheets.Add.Name = "Sheet2"
    Range("A1").Value = "Product Name"
    Range("B1").Value = "Margin Limit"
    Range("A2").Value = 103
    Range("B2").Value = 0.25
    Range("A3").Value = 108
    Range("B3").Value = 0.25
    Range("A4").Value = 116
    Range("B4").Value = 0.25
    Range("A1:B4").Select
    ActiveWorkbook.Names.Add Name:="Table", RefersToR1C1:="=Sheet2!R1C1:R4C2"
    ActiveWorkbook.Names.Add Name:="Table", RefersToR1C1:="=Sheet2!R1C1:R4C2"
     
     'Gets rid of empty rows and pastes totals into Totals sheet'
    Sheets.Add.Name = "Totals"
     
    Worksheets("Sheet1").Select
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row + 1
    Rows(lastrow & ":" & Rows.Count).Copy Worksheets("Totals").Range("A1")
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row - 2
    Rows(lastrow & ":" & Rows.Count).ClearContents
    '
    'maybe you have to sort it again!!!!!
    '
    Rows("1:4").Delete Shift:=xlUp
     
     'Deletes entries with acceptable margin %s'
    Dim j As Long, x As Double, r As Range
    Set r = Range("Table") 'The reference table with product in the first column and cutoff in the second
    j = Cells(Rows.Count, 1).End(xlUp).Row 'last line to check
    'here I would use ".clear" instead of ".delete" and then sort it again at the end
    While j > 1 'loop through all but the first row, starting at bottom
        x = IIf(Application.WorksheetFunction.IsError(Application.VLookup(Cells(j, 3), r, 2, 0)), 0.125, Application.VLookup(Cells(j, 3), r, 2, 0)) 'get cutoff value for this product code
        If Cells(j, 7) > x Then Rows(j).Delete
        j = j - 1
    Wend
     
     'Replaces names'
    lastrow = Range("A65536").End(xlUp).Row
    Range("A" & lastrow).Replace What:=" -*", Replacement:="", LookAt:= _
    xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
     
     'Splits data up by function code'
    Dim rng As Range, StrtSht As String, WhtSht As String
    StrtSht = ActiveSheet.Name
    For Each rng In Range("A1:A" & Range("A65536").End(xlUp).Row)
        Select Case rng.Value
          Case "21"
            WhtSht = "7"
          Case "34", "36", "37"
            WhtSht = "33"
          Case "56", "57"
            WhtSht = "55"
          Case "76"
            WhtSht = "75"
          Case "97"
            WhtSht = "96"
        End Select
        
        If SheetExists(WhtSht) Then
            Rows(rng.Row).Copy Sheets(WhtSht).Range("A" & Range("A65536").End(xlUp).Row + 1)
        Else
            Sheets.Add.Name = WhtSht
            Sheets(StrtSht).Rows(rng.Row).Copy Sheets(WhtSht).Range("A1")
        End If
    Next
     
     'Re-names sheets'
    Worksheets("7").Name = "7, 21"
    Worksheets("33").Name = "33, 34, 36, 37"
    Worksheets("55").Name = "55, 56, 57"
    Worksheets("75").Name = "75, 76"
    Worksheets("96").Name = "96, 97"
     
     'Deletes extra sheets'
    Application.DisplayAlerts = False
    Worksheets("Sheet1").Delete
    Worksheets("Sheet2").Delete
    Worksheets("Blank").Delete
    Worksheets("Function Code").Delete
    Application.DisplayAlerts = True
     
     'Formats columns and cells, and adds headers'
    With Worksheets("Totals")
      .Columns("A:B").Delete Shift:=xlToLeft
      .Rows("1:1").Insert Shift:=xlDown
      .Cells(1, 1) = "Product Code"
      .Cells(1, 2) = "Revenue Accrual Subtotal"
      .Cells(1, 3) = "Cost Accrual Subtotal"
      .Cells(1, 4) = "Margin Subtotal"
      .Columns("A:D").EntireColumn.AutoFit
      .Range("A1").Select
    End With
    
    With Sheets(Array("1", "7, 21", "31", "33, 34, 36, 37", "55, 56, 57", "75, 76", "96, 97"))
      .Select
      .Rows("1:1").Insert Shift:=xlDown
      .Cells(1, 1) = "Function Code"
      .Cells(1, 2) = "Project Number"
      .Cells(1, 3) = "Product Code"
      .Cells(1, 4) = "Revenue Accrual Sum"
      .Cells(1, 5) = "Cost Accrual Sum"
      .Cells(1, 6) = "Margin"
      .Cells(1, 7) = "Margin %"
      .Columns("A:G").EntireColumn.AutoFit
      .Columns("G:G").NumberFormat = "0.00%"
      .Range("A1").Select
    End With
     
    Application.ScreenUpdating = True
     
End Sub

Display More

filippo

filo65 · Jun 25th 2007

Re: Sort Matrix By Largest Value

Have you tried to run your code for large "n"s? eventually try and adapt to your needs one of the common sorting algorithm like bubble sort, insert, shell, etc...

filippo

filo65 · Jun 22nd 2007

Re: Sort Matrix By Largest Value

and a range "A1:C3" should be more appropriate.

How big can became your "n" ?

filippo

filo65 · Jun 21st 2007

Re: Macro That Will Export To Database In Access

Do you want to backup the workbook or the content?

filippo

filo65 · Jun 5th 2007

Re: Shared File Growing Massively

I thought as well it would be the same, but a quick check has shown me something different. Just in case, it is better to proof a couple of them.

filippo

filo65 · Jun 5th 2007

Re: Shared File Growing Massively

Are you sure that all users have the same settings?

I tried a share workbook on three machines and had the advanced option set differently in each PC.

filippo

filo65 · Jun 4th 2007

Re: Shortening This Formula

truCido,

welcome to ozgrid. your formula appears to be a little bit "heavy". Would eventually =DEC2BIN(.. , 8 ) help you?

filippo

filo65 · May 31st 2007

Re: Convert Fractional Odds To Decimals

BTC2,

I'm fascinated by the english peculiar way of calculating.::D

7/2 = 4.5? it's fantastic! It opens incredible business perspectives: you show a price, but you mean another ( at least here on the continent ).;)
Which format category should I look into? I searched in my german and english PC but I couldn't find any.

filippo

filo65 · May 29th 2007

Re: Dates Convert To Numbers

ByTheCringe2,

if I well understand what good2soft want to say is he's importing 7/2 and would like to have 7/2 or 3.5 in the cell and not the equivalent 7-Feb.

It happened something similar to me but the other way round: entering 1/2, 1/4 and 3/4 for 1-Feb, 1/3-April I got exactly 1/2, 1/4, 3/4 instead of my dates.
It's worth maybe to look under Tools->AutocorrectOptions ( Autocorrect Tab), to see if all setting are correct.

filippo

Posts by filo65

Working With 1 Million Records

Pass Element Of User-Defined Data Type

Vlookup Causing Slow Calculations

Vba Code To Enter Formula

Calculate Future Date Excluding Weekends

Calculate Future Date Excluding Weekends

Holiday Calendar Up To 2500 ( The Fast Way )

UDF Recalculating Prematurely

YEARFRAC & Leap Years

YEARFRAC & Leap Years

Optimize VBA Code

Optimize VBA Code

Sort Matrix By Largest Value

Sort Matrix By Largest Value

Macro That Will Export To Database In Access

Shared File Growing Massively

Shared File Growing Massively

Shortening This Formula

Convert Fractional Odds To Decimals

Convert Fractional Odds To Decimals