Free Microsoft Excel 2013 Quick Reference

Myrna Larson, locate??

Myrna was kind enough to provide some serious code for me some time back. I
am having trouble with it and would like to ask her about it. Hopefully she
will see this message, but if not, does anyone know how to reach her?

Main question about this code is where/how is "CouponBefore" and
"CouponAfter" calculated?
Thanks, Mike Allen

Myrna's code reads:
Option Explicit

Type BondInfoType
'supplied parameters
Settlement As Date
maturity As Date
Rate As Double
Price As Double
redemption As Double
frequency As Long
basis As Long

'calculated parameters
coupon As Double
NumCoupons As Long
FraxPeriod As Double
AccrInt As Double
End Type

Function BondYield(Settlement As Date, maturity As Date, _
Rate As Double, Price As Double, redemption As Double, _
frequency As Long, Optional basis As Long = 0) As Variant

Dim BondInfo As BondInfoType
Dim Diff As Double
Dim i As Long
Dim MaxYield As Double
Dim MinYield As Double
Dim Msg As String
Dim Yld As Double

Const Accuracy As Double = 0.0001
Const MaxIterations As Long = 200

With BondInfo
..Settlement = Settlement
..maturity = maturity
..Rate = Rate
..Price = Price
..redemption = redemption
..frequency = frequency
..basis = basis
End With

If CheckArguments(BondInfo, Msg) = False Then
BondYield = Msg
Exit Function
End If

CalculateRemainingParameters BondInfo

With BondInfo
If .NumCoupons = 1 Then
Yld = YieldWith1Coupon(BondInfo)

Else
MinYield = -1#
MaxYield = .Rate
If MaxYield = 0 Then MaxYield = 0.1
Do While CalculatedPrice(BondInfo, MaxYield) > .Price
MaxYield = MaxYield * 2
Loop

Yld = 0.5 * (MinYield + MaxYield)
For i = 1 To MaxIterations
Diff = CalculatedPrice(BondInfo, Yld) - .Price
If Abs(Diff) < Accuracy Then Exit For
'if calculated price is greater, correct yield is greater
If Diff > 0 Then MinYield = Yld Else MaxYield = Yld
Yld = 0.5 * (MinYield + MaxYield)
Next i
End If

BondYield = Yld

End With
End Function 'BondYield

Function BondPrice(Settlement As Date, maturity As Date, _
Rate As Double, yield As Double, redemption As Double, _
frequency As Long, Optional basis As Long = 0) As Variant

Dim BondInfo As BondInfoType
Dim Msg As String

With BondInfo
..Settlement = Settlement
..maturity = maturity
..Rate = Rate
..Price = 100 'dummy value for CheckArguments
..redemption = redemption
..frequency = frequency
..basis = basis
End With

If CheckArguments(BondInfo, Msg) = False Then
BondPrice = Msg
Else
CalculateRemainingParameters BondInfo
BondPrice = CalculatedPrice(BondInfo, yield)
End If

End Function 'BondPrice

Private Function CalculatedPrice(BondInfo As BondInfoType, Yld As Double)
Dim coupon As Double
Dim K As Long
Dim n As Long
Dim Price As Double
Dim t As Double
Dim y As Double

With BondInfo
n = .NumCoupons
y = 1 + Yld / .frequency
t = .FraxPeriod 'time to first coupon in periods
coupon = .coupon

'present value of the redemption price
Price = .redemption * (y ^ -(n - 1 + t))

'add present value of the coupons
If coupon > 0 Then
For K = 1 To n
Price = Price + coupon * (y ^ -t) 'Y^(-t) = 1/(Y^t)
t = t + 1
Next K
End If

'subtract accrued interest
Price = Price - .AccrInt

End With

CalculatedPrice = Price

End Function 'CalculatedPrice

Private Sub CalculateRemainingParameters(BondInfo As BondInfoType)
Dim CouponAfter As Long
Dim CouponBefore As Long
Dim DaysSettleToCoupon As Long
Dim CouponPeriodLength As Long 'in days
Dim settle As Long

With BondInfo
..coupon = 100 * .Rate / .frequency

GetCouponDates BondInfo, CouponBefore, CouponAfter

If .basis = 0 Then
CouponPeriodLength = Application.Days360(CouponBefore, CouponAfter)
DaysSettleToCoupon = Application.Days360(.Settlement, CouponAfter)
Else
CouponPeriodLength = CouponAfter - CouponBefore
DaysSettleToCoupon = CouponAfter - .Settlement
End If

..FraxPeriod = DaysSettleToCoupon / CouponPeriodLength
..AccrInt = .coupon * (1 - .FraxPeriod)

End With
End Sub 'CalculateRemainingParameters

Private Function CheckArguments(BondInfo As BondInfoType, _
Msg As String) As Boolean
Dim OK As Boolean

With BondInfo
OK = False
Msg = ""
Do
If .Settlement >= .maturity Then _
Msg = "Settlement date >= maturity date": Exit Do
If .Rate < 0 Then Msg = "Rate < 0": Exit Do
If .Price <= 0 Then Msg = "Purchase price <= 0": Exit Do
If .redemption <= 0 Then Msg = "Redemption price <= 0": Exit Do

Select Case .frequency
Case 1, 2, 3, 4, 6, 12
Case Else
Msg = "Frequency must be 1, 2, 3, 4, 6, or 12"
Exit Do
End Select

Select Case .basis
Case 0, 1
OK = True: Exit Do
Case Else
Msg = "Basis must be 0 or 1": Exit Do
End Select
Loop

End With
CheckArguments = OK
End Function 'CheckArguments

Private Sub GetCouponDates(BondInfo As BondInfoType, _
PrevCoup As Long, NextCoup As Long)
Dim MonthsBetweenCoupons As Integer

With BondInfo
MonthsBetweenCoupons = 12 .frequency

PrevCoup = DateSerial(Year(.Settlement) + 1, Month(.maturity),
Day(.maturity))
If PrevCoup > .maturity Then PrevCoup = .maturity
Do While PrevCoup > .Settlement
PrevCoup = DateAdd("m", -MonthsBetweenCoupons, PrevCoup)
Loop
..NumCoupons = DateDiff("m", PrevCoup, .maturity) MonthsBetweenCoupons
NextCoup = DateAdd("m", MonthsBetweenCoupons, PrevCoup)
End With
End Sub 'GetCouponDates

Private Function YieldWith1Coupon(BondInfo As BondInfoType) As Double
Dim Cost As Double
Dim Gain As Double
Dim Proceeds As Double
Dim t As Double

With BondInfo
Proceeds = .redemption + .coupon 'receive at maturity
Cost = .Price + .AccrInt 'pay at purchase
Gain = Proceeds / Cost - 1
t = .FraxPeriod / .frequency 'time in years = frax * 1 / freq
End With

YieldWith1Coupon = Gain / t

End Function 'YieldWith1Coupon


Post your answer or comment

comments powered by Disqus
I've used the following code in Excel XP with no problems.
Now that I have Excel 2007, I keep getting an "Overflow" error when trying to run the code. Sometimes it will say "Runtime error '6':, Overflow"

When I step through the code (F8) the line that brings up the error is:

If N > Cells.Count Then GoTo DataError

To give an example of what values I'm entering use the following:

Cell A1 = c
Cell A2 = 5
Cells A3 - A17 = A-O (one letter per cell)

Any help would be greatly appreciated.

Option Explicit
Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet
'
'  Posted by Myrna Larson
'  July 25, 2000
'  Microsoft.Public.Excel.Misc
'  Subject:  Combin
'
'
'Since you asked, here it is. It is generic, i.e. it isn't written specifically
'for a given population and set size, as yours it. It will do permutations or
'combinations. It uses a recursive routine to generate the subsets, one routine
'for combinations, a different one for permutations.
'To use it, you put the letter C or P (for combinations or permutations) in a
'cell. The cell below that contains the number of items in a subset. The Cells
'below are a list of the items that make up the population. They could be
'numbers, letters and symbols, or words, etc.
'You select the top cell, or the entire range and run the sub. The subsets are
'written to a new sheet in the workbook.
'
'
Sub ListPermutations()
  Dim Rng As Range
  Dim PopSize As Integer
  Dim SetSize As Integer
  Dim Which As String
  Dim N As Double
  Const BufferSize As Long = 4096
  Set Rng = Selection.Columns(1).Cells
  If Rng.Cells.Count = 1 Then
    Set Rng = Range(Rng, Rng.End(xlDown))
  End If
  PopSize = Rng.Cells.Count - 2
  If PopSize < 2 Then GoTo DataError
  SetSize = Rng.Cells(2).Value
  If SetSize > PopSize Then GoTo DataError
  Which = UCase$(Rng.Cells(1).Value)
  Select Case Which
  Case "C"
    N = Application.WorksheetFunction.Combin(PopSize, SetSize)
  Case "P"
    N = Application.WorksheetFunction.Permut(PopSize, SetSize)
  Case Else
    GoTo DataError
  End Select
  If N > Cells.Count Then GoTo DataError
  Application.ScreenUpdating = False
  Set Results = Worksheets.Add
  vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value
  ReDim Buffer(1 To BufferSize) As String
  BufferPtr = 0
  If Which = "C" Then
    AddCombination PopSize, SetSize
  Else
    AddPermutation PopSize, SetSize
  End If
  vAllItems = 0
  Application.ScreenUpdating = True
  Exit Sub
DataError:
  If N = 0 Then
    Which = "Enter your data in a vertical range of at least 4 cells. " _
      & String$(2, 10) _
      & "Top cell must contain the letter C or P, 2nd cell is the number " _
      & "of items in a subset, the cells below are the values from which " _
      & "the subset is to be chosen."
  Else
    Which = "This requires " & Format$(N, "#,##0") & _
      " cells, more than are available on the worksheet!"
  End If
  MsgBox Which, vbOKOnly, "DATA ERROR"
  Exit Sub
End Sub
Private Sub AddPermutation(Optional PopSize As Integer = 0, _
  Optional SetSize As Integer = 0, _
  Optional NextMember As Integer = 0)
  Static iPopSize As Integer
  Static iSetSize As Integer
  Static SetMembers() As Integer
  Static Used() As Integer
  Dim i As Integer
  If PopSize <> 0 Then
    iPopSize = PopSize
    iSetSize = SetSize
    ReDim SetMembers(1 To iSetSize) As Integer
    ReDim Used(1 To iPopSize) As Integer
    NextMember = 1
  End If
  For i = 1 To iPopSize
    If Used(i) = 0 Then
      SetMembers(NextMember) = i
      If NextMember <> iSetSize Then
        Used(i) = True
        AddPermutation , , NextMember + 1
        Used(i) = False
      Else
        SavePermutation SetMembers()
      End If
    End If
  Next i
  If NextMember = 1 Then
    SavePermutation SetMembers(), True
    Erase SetMembers
    Erase Used
  End If
End Sub  'AddPermutation
Private Sub AddCombination(Optional PopSize As Integer = 0, _
  Optional SetSize As Integer = 0, _
  Optional NextMember As Integer = 0, _
  Optional NextItem As Integer = 0)
  Static iPopSize As Integer
  Static iSetSize As Integer
  Static SetMembers() As Integer
  Dim i As Integer
  If PopSize <> 0 Then
    iPopSize = PopSize
    iSetSize = SetSize
    ReDim SetMembers(1 To iSetSize) As Integer
    NextMember = 1
    NextItem = 1
  End If
  For i = NextItem To iPopSize
    SetMembers(NextMember) = i
    If NextMember <> iSetSize Then
      AddCombination , , NextMember + 1, i + 1
    Else
      SavePermutation SetMembers()
    End If
  Next i
  If NextMember = 1 Then
    SavePermutation SetMembers(), True
    Erase SetMembers
  End If
End Sub  'AddCombination
Private Sub SavePermutation(ItemsChosen() As Integer, _
  Optional FlushBuffer As Boolean = False)
  Dim i As Integer, sValue As String
  Static RowNum As Long, ColNum As Long
  If RowNum = 0 Then RowNum = 1
  If ColNum = 0 Then ColNum = 1
  If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
    If BufferPtr > 0 Then
      If (RowNum + BufferPtr - 1) > Rows.Count Then
        RowNum = 1
        ColNum = ColNum + 1
        If ColNum > 256 Then Exit Sub
      End If
      Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
        = Application.WorksheetFunction.Transpose(Buffer())
      RowNum = RowNum + BufferPtr
    End If
    BufferPtr = 0
    If FlushBuffer = True Then
      Erase Buffer
      RowNum = 0
      ColNum = 0
      Exit Sub
    Else
      ReDim Buffer(1 To UBound(Buffer))
    End If
  End If
  'construct the next set
  For i = 1 To UBound(ItemsChosen)
    sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
  Next i
  'and save it in the buffer
  BufferPtr = BufferPtr + 1
  Buffer(BufferPtr) = Mid$(sValue, 3)
End Sub  'SavePermutation


Hi,

I have been to numerous forums where they discuss combinations/permutations macro by Myrna Larson, and reasons why it might not work. Unfortunately I didn't find solution for my issue.

As required by the macro, I inserted C into A1 (for choosing combinations); A2 = 2 (for pairs) and A3:A8 variables to be combined. (although irrelevant, I am interested in generating pairs)

First I get "Compile error: Sub or formula not defined" highlighting: If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then

Secondly I get "Compile error: Invalid Redim" highlighting: ReDim Buffer(1 To UBound(Buffer))

Could you please help me with these? How to resolve the issues so that the macro will generate the combinations(I am only interested in the combinations, not the permutations). I've got 2007 Excel, and am a bit new to the VBA.

The original Myrna Larson macro is as follows:

Dim
vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet

Sub ListPermutationsOrCombinations()
Dim Rng As Range
Dim PopSize As Integer
Dim SetSize As Integer
Dim Which As String
Dim n As Double
Const BufferSize As Long = 4096

Worksheets("Sheet1").Range("A1").Select
Set Rng = Selection.Columns(1).Cells
If Rng.Cells.Count = 1 Then
Set Rng = Range(Rng, Rng.End(xlDown))
End If

PopSize = Rng.Cells.Count - 2
If PopSize < 2 Then GoTo DataError

SetSize = Rng.Cells(2).Value
If SetSize > PopSize Then GoTo DataError

Which = UCase$(Rng.Cells(1).Value)
Select Case Which
Case "C"
n = Application.WorksheetFunction.Combin(PopSize, SetSize)
Case "P"
n = Application.WorksheetFunction.Permut(PopSize, SetSize)
Case Else
GoTo DataError
End Select
If n > Cells.Count Then GoTo DataError

Application.ScreenUpdating = False

Set Results = Worksheets.Add

vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value
ReDim Buffer(1 To BufferSize) As String
BufferPtr = 0

If Which = "C" Then
AddCombination PopSize, SetSize
Else
AddPermutation PopSize, SetSize
End If
vAllItems = 0

Application.ScreenUpdating = True
Exit Sub

DataError:
If n = 0 Then
Which = "Enter your data in a vertical range of at least 4 cells." _
& String$(2, 10) _
& "Top cell must contain the letter C or P, 2nd cell is the Number" _
& "of items in a subset, the cells below are the values from Which" _
& "the subset is to be chosen."

Else
Which = "This requires " & Format$(n, "#,##0") & _
" cells, more than are available on the worksheet!"
End If
MsgBox Which, vbOKOnly, "DATA ERROR"
Exit Sub
End Sub

Private Sub AddPermutation(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Static Used() As Integer
Dim i As Integer

If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
ReDim Used(1 To iPopSize) As Integer
NextMember = 1
End If

For i = 1 To iPopSize
If Used(i) = 0 Then
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
Used(i) = True
AddPermutation , , NextMember + 1
Used(i) = False
Else
SavePermutation SetMembers()
End If
End If
Next i

If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
Erase Used
End If

End Sub 'AddPermutation

Private Sub AddCombination(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0, _
Optional NextItem As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Dim i As Integer

If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
NextMember = 1
NextItem = 1
End If

For i = NextItem To iPopSize
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
AddCombination , , NextMember + 1, i + 1
Else
SavePermutation SetMembers()
End If
Next i

If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
End If

End Sub 'AddCombination

Private Sub SavePermutation(ItemsChosen() As Integer, _
Optional FlushBuffer As Boolean = False)
Dim i As Long, sValue As String
Static RowNum As Long, ColNum As Long

If RowNum = 0 Then RowNum = 1
If ColNum = 0 Then ColNum = 1

If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
If BufferPtr > 0 Then
If (RowNum + BufferPtr - 1) > Rows.Count Then
RowNum = 1
ColNum = ColNum + 1
If ColNum > 256 Then Exit Sub
End If

Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
= Application.WorksheetFunction.Transpose(Buffer())
RowNum = RowNum + BufferPtr
End If

BufferPtr = 0
If FlushBuffer = True Then
Erase Buffer
RowNum = 0
ColNum = 0
Exit Sub
Else
ReDim Buffer(1 To UBound(Buffer))
End If

End If

'construct the next set
For i = 1 To UBound(ItemsChosen)
sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
Next i

'and save it in the buffer
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = Mid$(sValue, 3)
End Sub 'SavePermutation


I have been using the code below which is a very slight adaptation of Myrna's original recommendation. As Jamie, kindly pointed out there are 8 exceptions to the UK Postcode system which start with just one alpha character! I need to be able to let these pass through, so basically I need to allow both the following codes...

"[A-Z][A-Z]## #[A-Z][A-Z]"
and
"[A-Z]## #[A-Z][A-Z]"

The 8 Codes that break the rule a begin with the following...

B - Birmingham
E - East London
G - Glasgow
L - Liverpool
M - Manchester
N - North London
S - Sheffield
W - West London

Hope this makes sense? Maybe once they have put the postcode in maybe a dialog box can confirm that the address is indeed "Manchester?" for example...

One more point I need addressing is that the first part of the postcode is sometimes a single figure. I will need for the code to put in a 0(zero) to cover this... For example their post code maybe SW4 2AP I need the program to realise that in order to format correctly it needs to add a 0 i.e. the correct results would be SW04 2AP. This is due to the users only putting it in lazily and not fully understanding the postal coding system.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As String

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("F2:F25000")) Is Nothing Then
With Target
X = UCase$(.Value)
If X Like "[A-Z][A-Z]0# #[A-Z][A-Z]" Then
'it's OK as is
ElseIf X Like "[A-Z][A-Z]0##[A-Z][A-Z]" Then
X = Left$(X, 4) & " " & Right$(X, 3)
Else
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "Error!"
'leave the string as-is so they can correct without
'retyping the whole thing
End If
.Value = X
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

Hope you guys or somebody else can help me on this one. I'm more used to using vb.net and VBA is turning me around and I don't want to conflict my thoughts.

Scott

I am refering to a post http://www.ozgrid.com/forum/showthre...t=90873&page=1 ...and http://www.ozgrid.com/forum/showthread.php?t=28321
Re: Creating All Combinations Of 7 Numbers

Hi

Welcome on-board [IMG]file:///C:/DOCUME%7E1/Carl/LOCALS%7E1/Temp/msohtmlclip1/01/clip_image001.gif[/IMG]

See here and here.

These are just 2 of the places on internet where the "famous" code by Myrna Larson resides. Tested and approved by many [IMG]file:///C:/DOCUME%7E1/Carl/LOCALS%7E1/Temp/msohtmlclip1/01/clip_image002.gif[/IMG]

Wigi
http://www.wimgielis.be. Excel (VBA code + example files), sports and music. I am unsuccessful in using the code. I done a bit of research and some other users has the same problem especially users of Excel2007. Is there a update of this code available? I am new to Excel.
Looking forward to here from the Board..... Below is the Code

	VB:
	
 
 
Dim vAllItems As Variant 
Dim Buffer() As String 
Dim BufferPtr As Long 
Dim Results As Worksheet 
 '
 ' Myrna Larson, July 25, 2000, Microsoft.Public.Excel.Misc
 
Sub ListPermutationsOrCombinations() 
    Dim Rng As Range 
    Dim PopSize As Integer 
    Dim SetSize As Integer 
    Dim Which As String 
    Dim n As Double 
    Const BufferSize As Long = 4096 
     
    Worksheets("Sheet1").Range("A1").Select 
    Set Rng = Selection.Columns(1).Cells 
    If Rng.Cells.Count = 1 Then 
        Set Rng = Range(Rng, Rng.End(xlDown)) 
    End If 
     
    PopSize = Rng.Cells.Count - 2 
    If PopSize < 2 Then Goto DataError 
     
    SetSize = Rng.Cells(2).Value 
    If SetSize > PopSize Then Goto DataError 
     
    Which = UCase$(Rng.Cells(1).Value) 
    Select Case Which 
    Case "C" 
        n = Application.WorksheetFunction.Combin(PopSize, SetSize) 
    Case "P" 
        n = Application.WorksheetFunction.Permut(PopSize, SetSize) 
    Case Else 
        Goto DataError 
    End Select 
    If n > Cells.Count Then Goto DataError 
     
    Application.ScreenUpdating = False 
     
    Set Results = Worksheets.Add 
     
    vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value 
    Redim Buffer(1 To BufferSize) As String 
    BufferPtr = 0 
     
    If Which = "C" Then 
        AddCombination PopSize, SetSize 
    Else 
        AddPermutation PopSize, SetSize 
    End If 
    vAllItems = 0 
     
    Application.ScreenUpdating = True 
    Exit Sub 
     
DataError: 
    If n = 0 Then 
        Which = "Enter your data in a vertical range of at least 4 cells." _ 
        & String$(2, 10) _ 
        & "Top cell must contain the letter C or P, 2nd cell is the Number" _ 
        & "of items in a subset, the cells below are the values from Which" _ 
        & "the subset is to be chosen." 
         
    Else 
        Which = "This requires " & Format$(n, "#,##0") & _ 
        " cells, more than are available on the worksheet!" 
    End If 
    MsgBox Which, vbOKOnly, "DATA ERROR" 
    Exit Sub 
End Sub 
 
Private Sub AddPermutation(Optional PopSize As Integer = 0, _ 
    Optional SetSize As Integer = 0, _ 
    Optional NextMember As Integer = 0) 
     
    Static iPopSize As Integer 
    Static iSetSize As Integer 
    Static SetMembers() As Integer 
    Static Used() As Integer 
    Dim i As Integer 
     
    If PopSize  0 Then 
        iPopSize = PopSize 
        iSetSize = SetSize 
        Redim SetMembers(1 To iSetSize) As Integer 
        Redim Used(1 To iPopSize) As Integer 
        NextMember = 1 
    End If 
     
    For i = 1 To iPopSize 
        If Used(i) = 0 Then 
            SetMembers(NextMember) = i 
            If NextMember  iSetSize Then 
                Used(i) = True 
                AddPermutation , , NextMember + 1 
                Used(i) = False 
            Else 
                SavePermutation SetMembers() 
            End If 
        End If 
    Next i 
     
    If NextMember = 1 Then 
        SavePermutation SetMembers(), True 
        Erase SetMembers 
        Erase Used 
    End If 
     
End Sub 'AddPermutation
 
Private Sub AddCombination(Optional PopSize As Integer = 0, _ 
    Optional SetSize As Integer = 0, _ 
    Optional NextMember As Integer = 0, _ 
    Optional NextItem As Integer = 0) 
     
    Static iPopSize As Integer 
    Static iSetSize As Integer 
    Static SetMembers() As Integer 
    Dim i As Integer 
     
    If PopSize  0 Then 
        iPopSize = PopSize 
        iSetSize = SetSize 
        Redim SetMembers(1 To iSetSize) As Integer 
        NextMember = 1 
        NextItem = 1 
    End If 
     
    For i = NextItem To iPopSize 
        SetMembers(NextMember) = i 
        If NextMember  iSetSize Then 
            AddCombination , , NextMember + 1, i + 1 
        Else 
            SavePermutation SetMembers() 
        End If 
    Next i 
     
    If NextMember = 1 Then 
        SavePermutation SetMembers(), True 
        Erase SetMembers 
    End If 
     
End Sub 'AddCombination
 
Private Sub SavePermutation(ItemsChosen() As Integer, _ 
    Optional FlushBuffer As Boolean = False) 
     
    Dim i As Integer, sValue As String 
    Static RowNum As Long, ColNum As Long 
     
    If RowNum = 0 Then RowNum = 1 
    If ColNum = 0 Then ColNum = 1 
     
    If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then 
        If BufferPtr > 0 Then 
            If (RowNum + BufferPtr - 1) > Rows.Count Then 
                RowNum = 1 
                ColNum = ColNum + 1 
                If ColNum > 256 Then Exit Sub 
            End If 
             
            Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _ 
            = Application.WorksheetFunction.Transpose(Buffer()) 
            RowNum = RowNum + BufferPtr 
        End If 
         
        BufferPtr = 0 
        If FlushBuffer = True Then 
            Erase Buffer 
            RowNum = 0 
            ColNum = 0 
            Exit Sub 
        Else 
            Redim Buffer(1 To UBound(Buffer)) 
        End If 
         
    End If 
     
     'construct the next set
    For i = 1 To UBound(ItemsChosen) 
        sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1) 
    Next i 
     
     'and save it in the buffer
    BufferPtr = BufferPtr + 1 
    Buffer(BufferPtr) = Mid$(sValue, 3) 
End Sub 'SavePermutation

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Following is a macro based solution form Myrna Larson (Microsoft MVP) on permutation and combinations

1. It allows Combinations or Permutations (see note below).
2. The macro handles numbers, text strings, words (e.g. names of people) or symbols.
3. The combinations are written to a new sheet.
4. Results are returned almost instantaneously.

Setup:
In sheet1:
Cell A1, put “C” (Combinations) or “P” (Permutations).
Cell A2, put the number of items in the subset – in my case it’s 3.
Cells A3 down, your list. - in my case (numbers from 1-5)

My question is:
================

What changes do I need to make to this VBA code to get multiple combinations in just one go. Example:

If I have C in A1, 3 in A2 and Numbers from 1-5 in the range A3:A7 and if I run the macro, it will give me all possible combinations of 3 in sheet2

If I have two conditions

1. If I have C in A1, 3 in A2 and Numbers from 1-5 in the range A3:A7 and if I run the macro, it will give me all possible combinations of 3 in sheet2

2. Lets say if I have C in B1, 3 in B2 and Numbers from 1-5 in the range B3:B7 and if I run the macro, it should give me all possible combinations of 3 in sheet2 in columns A and B

== AND ==

Is it possible to put the output of the below given VBA code in ACCESS table in just one field instead of Sheet2 of the same worksheet?

I have 21 names and I want to make a group of 7 people which totals up to 116280 (=COMBIN(21,7)). Instead of having 65536 names in column A of Sheet2 and 50744 names in column B of Sheet2, I want to put the entire 116280 names in an ACCESS Table in just one field.

Maxi
====

HERE IS THE CODE:


	VB:
	
 
 
Dim vAllItems As Variant 
Dim Buffer() As String 
Dim BufferPtr As Long 
Dim Results As Worksheet 
 '
 ' Myrna Larson, July 25, 2000, Microsoft.Public.Excel.Misc
 
Sub ListPermutationsOrCombinations() 
    Dim Rng As Range 
    Dim PopSize As Integer 
    Dim SetSize As Integer 
    Dim Which As String 
    Dim n As Double 
    Const BufferSize As Long = 4096 
     
    Worksheets("Sheet1").Range("A1").Select 
    Set Rng = Selection.Columns(1).Cells 
    If Rng.Cells.Count = 1 Then 
        Set Rng = Range(Rng, Rng.End(xlDown)) 
    End If 
     
    PopSize = Rng.Cells.Count - 2 
    If PopSize < 2 Then Goto DataError 
     
    SetSize = Rng.Cells(2).Value 
    If SetSize > PopSize Then Goto DataError 
     
    Which = UCase$(Rng.Cells(1).Value) 
    Select Case Which 
    Case "C" 
        n = Application.WorksheetFunction.Combin(PopSize, SetSize) 
    Case "P" 
        n = Application.WorksheetFunction.Permut(PopSize, SetSize) 
    Case Else 
        Goto DataError 
    End Select 
    If n > Cells.Count Then Goto DataError 
     
    Application.ScreenUpdating = False 
     
    Set Results = Worksheets.Add 
     
    vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value 
    Redim Buffer(1 To BufferSize) As String 
    BufferPtr = 0 
     
    If Which = "C" Then 
        AddCombination PopSize, SetSize 
    Else 
        AddPermutation PopSize, SetSize 
    End If 
    vAllItems = 0 
     
    Application.ScreenUpdating = True 
    Exit Sub 
     
DataError: 
    If n = 0 Then 
        Which = "Enter your data in a vertical range of at least 4 cells." _ 
        & String$(2, 10) _ 
        & "Top cell must contain the letter C or P, 2nd cell is the Number" _ 
        & "of items in a subset, the cells below are the values from Which" _ 
        & "the subset is to be chosen." 
         
    Else 
        Which = "This requires " & Format$(n, "#,##0") & _ 
        " cells, more than are available on the worksheet!" 
    End If 
    MsgBox Which, vbOKOnly, "DATA ERROR" 
    Exit Sub 
End Sub 
 
Private Sub AddPermutation(Optional PopSize As Integer = 0, _ 
    Optional SetSize As Integer = 0, _ 
    Optional NextMember As Integer = 0) 
     
    Static iPopSize As Integer 
    Static iSetSize As Integer 
    Static SetMembers() As Integer 
    Static Used() As Integer 
    Dim i As Integer 
     
    If PopSize  0 Then 
        iPopSize = PopSize 
        iSetSize = SetSize 
        Redim SetMembers(1 To iSetSize) As Integer 
        Redim Used(1 To iPopSize) As Integer 
        NextMember = 1 
    End If 
     
    For i = 1 To iPopSize 
        If Used(i) = 0 Then 
            SetMembers(NextMember) = i 
            If NextMember  iSetSize Then 
                Used(i) = True 
                AddPermutation , , NextMember + 1 
                Used(i) = False 
            Else 
                SavePermutation SetMembers() 
            End If 
        End If 
    Next i 
     
    If NextMember = 1 Then 
        SavePermutation SetMembers(), True 
        Erase SetMembers 
        Erase Used 
    End If 
     
End Sub 'AddPermutation
 
Private Sub AddCombination(Optional PopSize As Integer = 0, _ 
    Optional SetSize As Integer = 0, _ 
    Optional NextMember As Integer = 0, _ 
    Optional NextItem As Integer = 0) 
     
    Static iPopSize As Integer 
    Static iSetSize As Integer 
    Static SetMembers() As Integer 
    Dim i As Integer 
     
    If PopSize  0 Then 
        iPopSize = PopSize 
        iSetSize = SetSize 
        Redim SetMembers(1 To iSetSize) As Integer 
        NextMember = 1 
        NextItem = 1 
    End If 
     
    For i = NextItem To iPopSize 
        SetMembers(NextMember) = i 
        If NextMember  iSetSize Then 
            AddCombination , , NextMember + 1, i + 1 
        Else 
            SavePermutation SetMembers() 
        End If 
    Next i 
     
    If NextMember = 1 Then 
        SavePermutation SetMembers(), True 
        Erase SetMembers 
    End If 
     
End Sub 'AddCombination
 
Private Sub SavePermutation(ItemsChosen() As Integer, _ 
    Optional FlushBuffer As Boolean = False) 
     
    Dim i As Integer, sValue As String 
    Static RowNum As Long, ColNum As Long 
     
    If RowNum = 0 Then RowNum = 1 
    If ColNum = 0 Then ColNum = 1 
     
    If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then 
        If BufferPtr > 0 Then 
            If (RowNum + BufferPtr - 1) > Rows.Count Then 
                RowNum = 1 
                ColNum = ColNum + 1 
                If ColNum > 256 Then Exit Sub 
            End If 
             
            Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _ 
            = Application.WorksheetFunction.Transpose(Buffer()) 
            RowNum = RowNum + BufferPtr 
        End If 
         
        BufferPtr = 0 
        If FlushBuffer = True Then 
            Erase Buffer 
            RowNum = 0 
            ColNum = 0 
            Exit Sub 
        Else 
            Redim Buffer(1 To UBound(Buffer)) 
        End If 
         
    End If 
     
     'construct the next set
    For i = 1 To UBound(ItemsChosen) 
        sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1) 
    Next i 
     
     'and save it in the buffer
    BufferPtr = BufferPtr + 1 
    Buffer(BufferPtr) = Mid$(sValue, 3) 
End Sub 'SavePermutation

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Thanks to all who replied. I was able to use the suggestions to get export
working properly.

"Myrna Larson" wrote:

> Save it as Formatted Text, space delimited (.prn)
>
> Be sure to set the font to fixed width and adjust the column widths correctly.
>
> On Mon, 24 Jan 2005 10:47:04 -0800, "FinChase"
> > wrote:
>
> >I need to export an Excel spreadsheet to a fixed width text file--it cannot
> >be tab- or comma-delimited. I've found that Access can do this correctly for
> >me and will let me control the export process. However, my problem is that
> >my company does not support Access so I have to find another method of
> >exporting, and about the only tool I have available is Excel. No matter what
> >I seem to do, it saves it in a tab-delimited format.
> >
> >To try and force it as a fixed width file, I change the font to Courier New,
> >then I save it as a MS-DOS .txt file. Can someone suggest something that may
> >help?
>
>

Hello,

I've been attempting to use XIRR with non contiguous cells, in Excel 97, but
without success.

My data (investment fund Unit Prices) is arranged in columns (dates in A,
values in B, sorted in ascending order) and I'm wanting to calculate
annualized returns over various periods.

My lack of success lead to a very long search of the newsgroup archives, as
well as other sources. I finally found out that it's not possible to use
XIRR 'directly' where the cells are non contiguous, but there were a couple
of workarounds suggested. One, a UDF from Harland Grove (submitted by Ron
Rosenfeld), and the second a formula using Offset, from Domenic. I also
came across the Function XXIRR, submitted by Myrna Larson.

However, I still have a couple of questions related to this and would
appreciate any feedback that people can offer.

1. The UDF works fine but has the drawback that the non-contiguous ranges
must be named. This is quite laborious when there are about 2000 data sets
and one wants to do many XIRR comparisons. Also, at least one of the values
for XIRR must be a negative and therefore the UDF doesn't work on my
original data as they are all positive values. Is there any way that the
UDF can be modified to change one value (the first, corresponding to the
earliest date, presumably) to a negative?

===========================
Function myxirr( _
v As Variant, _
d As Variant, _
Optional g As Double = 0 _
) As Variant
'-------------------------------------------------------
'this udf requires an explicit reference to APTVBAEN.XLA
'if v and/or d represent non-contiguous ranges, they should be
'NAME'd
'-------------------------------------------------------
Dim vv As Variant, dd As Variant, X As Variant, i As Long

If TypeOf v Is Range Then
ReDim vv(1 To v.Cells.Count)
i = 0
For Each X In v
i = i + 1
vv(i) = X.Value
Next X
Else
vv = v
End If

If TypeOf d Is Range Then
ReDim dd(1 To d.Cells.Count)
i = 0
For Each X In d
i = i + 1
dd(i) = X.Value
Next X
Else
dd = d
End If

myxirr = IIf(g 0, xirr(vv, dd, g), xirr(vv, dd))
End Function
===========================

2. Another query I found posted, but for which I didn't see any reply, also
applies to my situation. Any help would be most appreciated. Namely:

> I use the XIRR function regularly but would like to input relative
> references instead of always using arrays or constants (as in the Help
> example) but if I try this I get an error. Specifically I would like
> to do something like this: xirr({-b1,b2},{a1,a2}). This way I can
> calculate the period return from a list of positive values (e.g.
> balances as of a certain date).

The '-b1' causes the error, with dates in column A and values in column B.

3. From a thread titled "XIRR in VBA" - by Myrna Larson

Option Explicit

Const MaxChange As Double = 0.00000001
Const MaxTries As Long = 100

Enum ArrayDims '07/26/2003
NotArray = 0
SingleDim = 1
Horizontal = 2
Vertical = 3
Rectangular = 0
End Enum

etc. etc.

When I paste the code into the VBE the lines "Enum ArrayDims" and "End Enum"
are both highlighted in red.

Does this mean that "Enum" is not available in Excel 97?

If it's not, is there any alternative that would allow use of this function
in Excel 97?

Apologies for the length of this post, but I thought it was best to pose all
the questions at the same time since they're related.

Regards,

John

Along the same lines as Jay's suggestion...

Myrna Larson and Bill Manville have developed a compare that's very nice.

http://www.cpearson.com/excel/whatsnew.htm
look for compare.xla

But the bad news is that this does a cell-by-cell comparison. A1 compares to
A1, x99 to x99, etc.

If you insert/delete a row or column, then this won't work very well.

=======
Other alternatives that may work depending on what kind of differences you're
looking for:

Save each worksheet as a .csv file and use any comparison program you want to
compare two text files.

MSWord can compare two documents (or plain old text files), too.

Tavish Muldoon wrote:
>
> Is there a way to compare 2 spreadsheets?
>
> Almost like a Unix 'diff' command.
>
> I have several variants of certain large spreadsheets with only minor
> differences - and I want to review them. Find the differences and reconcile them.
>
> Any suggestions?
>
> Thx.
>
> Tmuld.

--

Dave Peterson

I misread your question. I couldn't imagine that a trend of a particular
length would be significiant, but then I'm not a technician.

If you can't get the proposed worksheet formula for D500 to work, it would be
possible to modify the VBA code to specify both the data range and the length
of the trend.

That might be easier than reworking those formulas if you decide you now want
to look for 2-day or 4-day trends .

On Tue, 26 Oct 2004 20:47:01 -0700, George B.
> wrote:

>Hello Myrna,
>I appreciate your advice. Just to clarify the stock data I am using, "A"
>column contains the "low" of day, and the "B" column is a "moving average"
>value. I don't care about intraday open, high or close values.
>
>My intention was to identify this "trend" lasting EXACTLY 3 days in this
>case. My goal in creating this post was to have a formula in 1 cell at
>bottom showing me how many times this "specific trend" occured. Then another
>formula in a 2nd cell at bottom telling me what the average % of decline from
>the first "low of day" to the 3rd "low of day". (average of all trend
>declines together).
>
>As for making a million bucks in the stock market with this, I'm not sure
>how any one approach could be THE formula for success. The challenge of
>trying to make sense of the market is the driving factor me as much as trying
>to make money from it.
>
>I appreciate your help very much.
>George.
>
>"Myrna Larson" wrote:
>
>> I'm still not sure I understand the problem definition.
>>
>> In looking at the first formula below, it looks for this pattern like this:
>> A1 days (A1:A3 in this case). Was that your intention? I assumed the trend
could
>> be of any length. If I was wrong, then the macro won't do.
>>
>>
>> On Tue, 26 Oct 2004 18:47:03 -0700, George B.
>> > wrote:
>>
>> >Hi, The result in C500 is 28. Result in D500 is #DIV/0!
>> >
>> >The formula I used in C500 was exactly the formula you suggested.
>> >=SUMPRODUCT(--(A1:A397,--(A4:A400>A3:A399))
>> >
>> >The formula I used in D500 was exactly the other formula you suggested
also.
>> >=SUMPRODUCT(--(A1:A397,--(A4:A400>A3:A399),(1-A3:A399/A1:A397))/SUMPRODUCT(--A1:A397> >),--(A2:A398> >
>> >Thanks,
>> >George
>> >
>> >
>> >
>> >"Frank Kabel" wrote:
>> >
>> >> Hi
>> >> what result do you have in C500 and what are the exact formulas you
>> >> have used in both cells
>> >>
>> >> --
>> >> Regards
>> >> Frank Kabel
>> >> Frankfurt, Germany
>> >>
>> >> "Frank Kabel" > schrieb im Newsbeitrag
>> >> ...
>> >> > Hi
>> >> > not fully sure but try:
>> >> > C500:
>> >> >
>> >> =SUMPRODUCT(--(A1:A397> ,--(A4:A400>A3:A399))
>> >> >
>> >> >
>> >> > D500:
>> >> >
>> >> =SUMPRODUCT(--(A1:A397> ,--(A4:A400>A3:A399),(1-A3:A399/A1:A397))/SUMPRODUCT(--(A1:A397> >> ),--(A2:A398> >> >
>> >> >
>> >> > "George B." wrote:
>> >> >
>> >> > > Hello,
>> >> > > I have a tricky problem I would like to see if anyone is able to
>> >> figure out.
>> >> > > I need to find a certain “condition” that occurs many times
>> >> through 400 rows
>> >> > > of data. I want to place 2 formulas in cells C500 & D500 that will
>> >> find and
>> >> > > calculate the below example:
>> >> > >
>> >> > > A B What I need
>> >> > > 1 100 98
>> >> > > 2 95 97 ----- A2 dips below B2. I need
>> >> this
>> >> > > condition identified first.
>> >> > > 3 90 94 ----- A3 is less than A2. Column
>> >> B is no
>> >> > > longer relevant.
>> >> > > 4 85 91 ----- A4 is less than A3 Column
>> >> B is no
>> >> > > longer relevant.
>> >> > > 5 89 92 ----- A5 is larger than A4 Column
>> >> B is no
>> >> > > longer relevant.
>> >> > > 6 numbers in A & B after this do not matter after rows 2 thru
>> >> 5
>> >> > > “condition” has been found.
>> >> > > 7 continue down A & B to find the next “condition” as rows 2
>> >> thru 5.
>> >> > >
>> >> > >
>> >> > > Now in C500 instead of a result of “TRUE”, could C500 contain the
>> >> total
>> >> > > number of times this “condition” occurred between rows 1 thru 400?
>> >> (the
>> >> > > values in columns A & B constantly change).
>> >> > >
>> >> > > Finally in cell D500, what formula can I place here to (per example
>> >> above)
>> >> > > calculate the % decline in value of A4 from A2? With this
>> >> knowledge, I need
>> >> > > all the % declines of all the “conditions” found to result into an
>> >> AVERAGE %
>> >> > > drop showing up in cell D500.
>> >> > >
>> >> > > Thank you very much to anyone who can help me!
>> >> > > George B.
>> >> > >
>> >>
>> >>
>>
>>

Myrna, Andy and Jason have given me the answers I need - many thnaks!

"Myrna Larson" wrote:

> I'm confused by your examples. On the 17th you added just 1 hour, but on the
> 18 you added 2 hours and on the 19th 3 hours. What increment do you want?
>
> Do you want to add 25 hours each time? If so, you can just write the formula
> in A2 =A1+25/24 and copy down.
>
>
> On Fri, 16 Jul 2004 05:37:02 -0700, "La La Lara"
> > wrote:
>
> >Hi
> >
> >I have a date and time field (which I have formatted as dd/mm/yy hh.mm)
> >
> >16/07/04 09:30
> >
> >I would like to add (incrementally) an hour on to the time each day, so the
> first few days will be:
> >
> >17/07/04 10:30
> >18/07/04 12:30
> >19/07/04 15:30
> >
> >I have tried right-clicking and using the "series" function, but when I go
> into the "series" option I am not sure what to do. I have chosen the options
> step value = 1 and "growth" but it only updates the Day (dd) by one day. I
> can't get it to update the Hour (hh) by one hour each day.
> >
> >Any ideas anyone?
>
>

----------------------------------------------
| 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
----------------------------------------------
| 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 |
----------------------------------------------
| 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 |
----------------------------------------------
| 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 |
----------------------------------------------
| 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 |
----------------------------------------------
| 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 |
----------------------------------------------
| 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 |
----------------------------------------------
| 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 |
----------------------------------------------
| 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | |
----------------------------------------------

Please paste the above data in notepad with COURIER NEW font to view it
clearly.

I have a GRID in Excel like the one shown above. If you look at a
combination of 9 numbers " 9 17 25 33 41 49 57 65 73" You will notice
that these numbers do not intercept horizontally or vertically with any
other number within the combination.

Easier clarification: Take the first number in the combination "9" and
see vertically downwards (9th column), you would notice that any other
number from that COLUMN is not present in the combination and if you
see towards left (1st row), you would notice that any other number from
that ROW is not present in the combination

I would like to know how many such combinations of 9 could be made with
the above criteria.

Other examples for a combination of 9 numbers
2 10 21 32 40 51 61 72 80
8 9 16 33 41 49 57 65 73

I found a macro written by Myrna Larson that creates combinations. Here
is a link
http://www.mrexcel.com/board2/viewtopic.php?t=179001

Can this macro be modified to suit my needs?

This code by Myrna Larson will do it (read the directions).

Option Explicit

Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet
'
' Posted by Myrna Larson
' July 25, 2000
' Microsoft.Public.Excel.Misc
' Subject: Combin
'
'
'Since you asked, here it is. It is generic, i.e. it isn't written
specifically
'for a given population and set size, as yours it. It will do permutations
or
'combinations. It uses a recursive routine to generate the subsets, one
routine
'for combinations, a different one for permutations.

'To use it, you put the letter C or P (for combinations or permutations) in
a
'cell. The cell below that contains the number of items in a subset. The
cells
'below are a list of the items that make up the population. They could be
'numbers, letters and symbols, or words, etc.

'You select the top cell, or the entire range and run the sub. The subsets
are
'written to a new sheet in the workbook.
'
'

Sub ListPermutations()
Dim Rng As Range
Dim PopSize As Integer
Dim SetSize As Integer
Dim Which As String
Dim N As Double
Const BufferSize As Long = 4096

Set Rng = Selection.Columns(1).Cells
If Rng.Cells.Count = 1 Then
Set Rng = Range(Rng, Rng.End(xlDown))
End If

PopSize = Rng.Cells.Count - 2
If PopSize < 2 Then GoTo DataError

SetSize = Rng.Cells(2).Value
If SetSize > PopSize Then GoTo DataError

Which = UCase$(Rng.Cells(1).Value)
Select Case Which
Case "C"
N = Application.WorksheetFunction.Combin(PopSize, SetSize)
Case "P"
N = Application.WorksheetFunction.Permut(PopSize, SetSize)
Case Else
GoTo DataError
End Select
If N > Cells.Count Then GoTo DataError

Application.ScreenUpdating = False

Set Results = Worksheets.Add

vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value
ReDim Buffer(1 To BufferSize) As String
BufferPtr = 0

If Which = "C" Then
AddCombination PopSize, SetSize
Else
AddPermutation PopSize, SetSize
End If
vAllItems = 0

Application.ScreenUpdating = True
Exit Sub

DataError:
If N = 0 Then
Which = "Enter your data in a vertical range of at least 4 cells. " _
& String$(2, 10) _
& "Top cell must contain the letter C or P, 2nd cell is the number " _
& "of items in a subset, the cells below are the values from which " _
& "the subset is to be chosen."

Else
Which = "This requires " & Format$(N, "#,##0") & _
" cells, more than are available on the worksheet!"
End If
MsgBox Which, vbOKOnly, "DATA ERROR"
Exit Sub
End Sub

Private Sub AddPermutation(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Static Used() As Integer
Dim i As Integer

If PopSize 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
ReDim Used(1 To iPopSize) As Integer
NextMember = 1
End If

For i = 1 To iPopSize
If Used(i) = 0 Then
SetMembers(NextMember) = i
If NextMember iSetSize Then
Used(i) = True
AddPermutation , , NextMember + 1
Used(i) = False
Else
SavePermutation SetMembers()
End If
End If
Next i

If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
Erase Used
End If

End Sub 'AddPermutation

Private Sub AddCombination(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0, _
Optional NextItem As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Dim i As Integer

If PopSize 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
NextMember = 1
NextItem = 1
End If

For i = NextItem To iPopSize
SetMembers(NextMember) = i
If NextMember iSetSize Then
AddCombination , , NextMember + 1, i + 1
Else
SavePermutation SetMembers()
End If
Next i

If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
End If

End Sub 'AddCombination

Private Sub SavePermutation(ItemsChosen() As Integer, _
Optional FlushBuffer As Boolean = False)

Dim i As Integer, sValue As String
Static RowNum As Long, ColNum As Long

If RowNum = 0 Then RowNum = 1
If ColNum = 0 Then ColNum = 1

If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
If BufferPtr > 0 Then
If (RowNum + BufferPtr - 1) > Rows.Count Then
RowNum = 1
ColNum = ColNum + 1
If ColNum > 256 Then Exit Sub
End If

Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
= Application.WorksheetFunction.Transpose(Buffer())
RowNum = RowNum + BufferPtr
End If

BufferPtr = 0
If FlushBuffer = True Then
Erase Buffer
RowNum = 0
ColNum = 0
Exit Sub
Else
ReDim Buffer(1 To UBound(Buffer))
End If

End If

'construct the next set
For i = 1 To UBound(ItemsChosen)
sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
Next i

'and save it in the buffer
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = Mid$(sValue, 3)
End Sub 'SavePermutation

--
Regards,
Tom Ogilvy

"Josh" > wrote in message
...
> How can I take, say, number 1 through 10 and output the actual
> combinations/permutations, not just the result of the combination
function?
>
>

I've downloaded the patch indicated below and I'm still having the same
problem mentioned here where command buttons move after printing the
worksheet (via control-P command). While I'd like Excel to stop moving
the command buttons, if I can't prevent them from moving I'd like to
use code to move them back where I want them. Any ideas how I'd go
about doing that?

Matt

Dave Peterson wrote:
> xl2002???
>
> http://support.microsoft.com/default...b;EN-US;838910
> Controls move to the left of the worksheet in Microsoft Excel 2002
>
> But Jim Rech recently posted this:
> This article is now obsolete. Since the 10/12/2004 security patch
> there is no need to get a hotfix (although this article does not
directly
> mention this fix, it's in there).
>
> http://support.microsoft.com/default...b;en-us;832332
>
> But Myrna Larson posted that it didn't work for her in all her
workbooks.
>
> TSH wrote:
> >
> > I have some command button and list box in my excel worksheet. When
i print
> > his worksheet, some of the button at right sides will move to left
sides. Why?
>
> --
>
> Dave Peterson

QUATTRO PRO 10 files use .qpw suffix. Is there a conversion program for this?

"Myrna Larson" wrote:

> Conversions Plus, $70 as www.dataviz.com will do this.
>
> I have the product. If you have just one or two files, you can email them to
> me and I will convert and send back. myrna larson charter net,
> without any spaces.
>
> On Mon, 18 Oct 2004 09:23:02 -0700, "t" > wrote:
>
> >Is there a conversion utility that will convert Quattro .wb2 files to excel ?
> > The files were created under Quattro v 6 for windows... Running Office 2003
> >here... any help would be appreciated...
> >
> >thanks... t
>
>

Hi Myrna,

Thanks for responding. To whom are you making this suggestion?
::
--
Summer

"Myrna Larson" <anonymous@discussions.microsoft.com> wrote in message
news:dcjra11musi0gogrkg2nhub3kp646pp7ak@4ax.com...
| If you check Help for VLOOKUP, you'll see that it requires at least 3 and
| possibly 4 arguments. You've supplied only 1.
|
| I suggest you learn to use this function, as it's very useful.
|
|
| On Mon, 13 Jun 2005 15:55:19 GMT, "Summer" <summer@thecabinbythelake.com>
| wrote:
|
| >"JMB" <JMB@discussions.microsoft.com> wrote in message
| >news:563E5372-3665-431A-9484-AD8F4498F6D0@microsoft.com...
| >|I think the problem is I left out the & right before VLOOKUP(State).
| >
| >Hi,
| >
| >I still could not get this one to work with your suggested revision. When
I
| >added the ampersand, the formula still returned "You've entered too few
| >arguments for this function.". (I also added the equals sign and the
| >specified space after the specified comma):
| >
| >Your formula as originally posted:
| >
| >IF(A11="","",VLOOKUP(City)&"," VLOOKUP(State)&" "&VLOOKUP(Zip))
| >
| >Your formula with our revisions:
| >
| >=IF(A11="","",VLOOKUP(City)&","&" "&VLOOKUP(State)&" "&VLOOKUP(Zip))
| >
| >Does not work. Sorry.
| >----------------------
| >My understanding is that VLOOKUP requires four arguments. For example:
| >
| >lookup_value______
table_array__________col_index_num_________range_lookup
| >
| >A11_____________ClientAddress________3___________________FALSE (to
specify
| >exact match)
| >
| >The arguments in the whole formula would read something like: IF A11 is
| >blank, then leave blank, otherwise IF A11 = company name, THEN lookup
named
| >range of ClientAddress and return value in column 3, must be exact match.
| >----------------
| >I WAS able to get your formula to work if I gave City, State and Zip EACH
| >the same range as ClientAddress and included all four arguments for each
| >VLOOKUP function.
| >
| >The original named ranges were:
| >
| >ClientAddress- refers to: =Clients!$B$3:$F$25
| >Clients- refers to: =Clients!$B$3:$B$25
| >Services- refers to: =Services!$A$2:$A$7 (ignore - not appl. here)
| >
| >Added named ranges are:
| >
| >City- refers to: =Clients!$B$3:$F$25
| >State- refers to: =Clients!$B$3:$F$25
| >Zip-refers to: =Clients!$B$3:$F$25
| >
| >
| >There are no headers included in the ranges. I wonder if that would that
| >make a difference. I'll have to check this out.
| >
| >The final result with all revisions:
| >
| >=IF(A11="","",VLOOKUP(A11,City,3,FALSE)&","&" "
| >&VLOOKUP(A11,State,4,FALSE)&" "
| >&VLOOKUP(A11,Zip,5,FALSE))
| >
| >(This works! 106 characters long compared to the first revision of 133
char.
| >long compared to the original of 169 char. long )
| >
| >Thanks for all your helpful suggestions! I learned a lot from our
exchange.
|

I have been working my way through a project that checks for a travel
bill reconsilliation workbook (Without using filesearch, thanks to
Myrna Larson, Bob Phillips and Ron De Bruin, amongst others) on the
user's desktop, makes a backup copy, and reformats it into a CMS
Invoice import file.

The file conversion process has four steps, but the second one is the
only one I can't figure out how to automate:

A. The first step merges multiple spreadsheets together (Thank you,
David McRitchie for your massive guides), inserts a custom key/error
field (using my own custom TravelBillAnalysis function, the key merges
values from columns A,G,and J) and resorts the data based on the KEY
field values. The objective of this is to make all records flagged as
errors bubble up to the top. (Using Chip Pearson's delightful
ExtractElement function)

B. The second step hides the error rows and subtotals the AMOUNT field
based on changes in the KEY field. I need a subtotal of both where the
AMOUNT field equals the key field, but I also need to subtotal Fees
WITHIN those subtotals, where column 4 contains a given string "Fees"
or begins with "ARC". This much I am able to do with Excel's subtotal
tool and some complex formulas.

THE BIG PROBLEM!
================
The end-users demand the data appears in a certain format because they
must still manually modify it after this second step. I have to add
two columns in the middle of the data set, one for FEES and one for the
transaction TOTAL. I then have to move the subtotal information from
the inserted subtotal rows to the appropriate column in-line with the
last detail line before the subtotal row. Then I have to delete both
the empty subtotal rows and all other rows besides the last one in each
subtotal set where we want to move our subtotal information. (Does
that make sense?!) This In-line subtotal requirement is the part that
is killing me.

I've tried numerous combinations of formulas, subtotals, subsorts, etc
etc but I can't it to work. I've tried reversing the process to copy
down the data into the subtotal line using James Cone's
"FillInSubTotalBlanks()" subroutine, but then I can't figure out how to
target the correct lines to delete.

http://groups-beta.google.com/group/...7f161bbeae5260

Since the amount of data in the file varies each month, I have to keep
all of the reference ranges flexible, but subroutines I've found or
written for activecell movement and range selection get messed up when
the subtotal lines are created while the auto filter is engaged.

Any help would be greatly appreciated!

All,

I have found the xNetWorkDays code on Google Groups from Myrna Larson
and it works great to calculate the number of work days between two
dates inluding a list of holidays and whether the work week is 5 , 6,
or 7 days. What I'm trying to do is find the projected finish date for
a given task based on the start date, the duration allocated for the
task, workweek type (Sunday off, Sat/Sun off, or no days off) and a
holiday list. I've been using other formulas but can't seem to get it
quite right. Any help would be greatly appreciated.

What I would be looking for is a function with the following arguments:

= EndDate(StartDate, DaysOff, Duration,Holidays) where:
StartDate = Start of the task
DaysOff is the work week type (5 for Sat/Sun off, 6 for only Sun off,
and 7 for no days off)
Duration = Number of days allocated for the task
Holidays = a range array of holidays that are not worked

Mojado44

Hello everyone,

Right now I'm trying to get a list of all the possible combos of days off during a week. Currently I'm using a series of 1's and 0's to show what days a schedule has off.

Ex: 1011101 that series means Monday/Friday off.

So basically I'm trying to find a way to show all the possible combos of 1's and 0's in a series of 7. Both with two 0's and 3 0's, corresponding to two days off and 3 days off in a week.

I found this bit of code that sounded like it would do what I needed, however trying to execute it produces an overflow error and I'm not sure how to go about fixing that. Any help would be appreciated.

Thanks

Option Explicit

Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet
'
' Myrna Larson, July 25, 2000, Microsoft.Public.Excel.Misc

Sub ListPermutationsOrCombinations()
Dim Rng As Range
Dim PopSize As Integer
Dim SetSize As Integer
Dim Which As String
Dim n As Double
Const BufferSize As Long = 4096

Worksheets("Sheet1").Range("A1").Select
Set Rng = Selection.Columns(1).Cells
If Rng.Cells.Count = 1 Then
Set Rng = Range(Rng, Rng.End(xlDown))
End If

PopSize = Rng.Cells.Count - 2
If PopSize < 2 Then GoTo DataError

SetSize = Rng.Cells(2).Value
If SetSize > PopSize Then GoTo DataError

Which = UCase$(Rng.Cells(1).Value)
Select Case Which
Case "C"
n = Application.WorksheetFunction.Combin(PopSize, SetSize)
Case "P"
n = Application.WorksheetFunction.Permut(PopSize, SetSize)
Case Else
GoTo DataError
End Select
If n > Cells.Count Then GoTo DataError

Application.ScreenUpdating = False

Set Results = Worksheets.Add

vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value
ReDim Buffer(1 To BufferSize) As String
BufferPtr = 0

If Which = "C" Then
AddCombination PopSize, SetSize
Else
AddPermutation PopSize, SetSize
End If
vAllItems = 0

Application.ScreenUpdating = True
Exit Sub

DataError:
If n = 0 Then
Which = "Enter your data in a vertical range of at least 4 cells." _
& String$(2, 10) _
& "Top cell must contain the letter C or P, 2nd cell is the Number" _
& "of items in a subset, the cells below are the values from Which" _
& "the subset is to be chosen."

Else
Which = "This requires " & Format$(n, "#,##0") & _
" cells, more than are available on the worksheet!"
End If
MsgBox Which, vbOKOnly, "DATA ERROR"
Exit Sub
End Sub

Private Sub AddPermutation(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Static Used() As Integer
Dim i As Integer

If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
ReDim Used(1 To iPopSize) As Integer
NextMember = 1
End If

For i = 1 To iPopSize
If Used(i) = 0 Then
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
Used(i) = True
AddPermutation , , NextMember + 1
Used(i) = False
Else
SavePermutation SetMembers()
End If
End If
Next i

If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
Erase Used
End If

End Sub 'AddPermutation

Private Sub AddCombination(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0, _
Optional NextItem As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Dim i As Integer

If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
NextMember = 1
NextItem = 1
End If

For i = NextItem To iPopSize
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
AddCombination , , NextMember + 1, i + 1
Else
SavePermutation SetMembers()
End If
Next i

If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
End If

End Sub 'AddCombination

Private Sub SavePermutation(ItemsChosen() As Integer, _
Optional FlushBuffer As Boolean = False)

Dim i As Integer, sValue As String
Static RowNum As Long, ColNum As Long

If RowNum = 0 Then RowNum = 1
If ColNum = 0 Then ColNum = 1

If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
If BufferPtr > 0 Then
If (RowNum + BufferPtr - 1) > Rows.Count Then
RowNum = 1
ColNum = ColNum + 1
If ColNum > 256 Then Exit Sub
End If

Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
= Application.WorksheetFunction.Transpose(Buffer())
RowNum = RowNum + BufferPtr
End If

BufferPtr = 0
If FlushBuffer = True Then
Erase Buffer
RowNum = 0
ColNum = 0
Exit Sub
Else
ReDim Buffer(1 To UBound(Buffer))
End If

End If

'construct the next set
For i = 1 To UBound(ItemsChosen)
sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
Next i

'and save it in the buffer
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = Mid$(sValue, 3)
End Sub 'SavePermutation


Question:
I have 6 words and I'd like to see all of the possible combinations in which
they can occur for example - it - and - the - but - blue - yet. I've been
through the posts and Myrna Larson's download doesn't work for me - I keep
getting error messages with the values - is there a regular function in Excel
that will show me the combinations? If not - how can I do this? eg. I want to
see the permutations like the ones below etc... Thank you
the and
and the
but yet
yet but

The following code creates every 10 stock ticker combination from the list of 15 total in A3:A17and copies them to a new worksheet. Is there a way to change the code to create every 10, 11, 12, 13, 14 and 15 stock combination?

I would always like 10 to be the minimum number of stocks in each combination. If there are 20 total in the list (A3:A22) than create every 10-20 stock combination..ect

Option Explicit
 
Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet
 '
 ' Myrna Larson, July 25, 2000, Microsoft.Public.Excel.Misc
 
Sub ListPermutationsOrCombinations()
'Source:   http://www.ozgrid.com/forum/showthread.php?p=148992
'On Sheet1 A1, enter C for Combinations, or P for Permutations
'On Sheet1 A2, enter the number items for each subset
'On Sheet1 A3 and below, list your values
    Dim Rng As Range
    Dim PopSize As Integer
    Dim SetSize As Integer
    Dim Which As String
    Dim n As Double
    Const BufferSize As Long = 4096
     
    Worksheets("Correlations").Range("A1").Select
    Set Rng = Selection.Columns(1).Cells
    If Rng.Cells.Count = 1 Then
        Set Rng = Range(Rng, Rng.End(xlDown))
    End If
     
    PopSize = Rng.Cells.Count - 2
    If PopSize < 2 Then GoTo DataError
     
    SetSize = Rng.Cells(2).Value
    If SetSize > PopSize Then GoTo DataError
     
    Which = UCase$(Rng.Cells(1).Value)
    Select Case Which
    Case "C"
        n = Application.WorksheetFunction.Combin(PopSize, SetSize)
    Case "P"
        n = Application.WorksheetFunction.Permut(PopSize, SetSize)
    Case Else
        GoTo DataError
    End Select
    If n > Cells.Count Then GoTo DataError
     
    Application.ScreenUpdating = False
     
    Set Results = Worksheets.Add
     
    vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value
    ReDim Buffer(1 To BufferSize) As String
    BufferPtr = 0
     
    If Which = "C" Then
        AddCombination PopSize, SetSize
    Else
        AddPermutation PopSize, SetSize
    End If
    vAllItems = 0
     
    Application.ScreenUpdating = True
    Exit Sub
     
DataError:
    If n = 0 Then
        Which = "Enter your data in a vertical range of at least 4 cells." _
        & String$(2, 10) _
        & "Top cell must contain the letter C or P, 2nd cell is the Number" _
        & "of items in a subset, the cells below are the values from Which" _
        & "the subset is to be chosen."
         
    Else
        Which = "This requires " & Format$(n, "#,##0") & _
        " cells, more than are available on the worksheet!"
    End If
     MsgBox Which, vbOKOnly, "DATA  ERROR"
    Exit Sub
End Sub
 
Private Sub AddPermutation(Optional PopSize As Integer = 0, _
    Optional SetSize As Integer = 0, _
    Optional NextMember As Integer = 0)
     
    Static iPopSize As Integer
    Static iSetSize As Integer
    Static SetMembers() As Integer
    Static Used() As Integer
    Dim i As Integer
     
    If PopSize <> 0 Then
        iPopSize = PopSize
        iSetSize = SetSize
        ReDim SetMembers(1 To iSetSize) As Integer
        ReDim Used(1 To iPopSize) As Integer
        NextMember = 1
    End If
     
    For i = 1 To iPopSize
        If Used(i) = 0 Then
            SetMembers(NextMember) = i
            If NextMember <> iSetSize Then
                Used(i) = True
                AddPermutation , , NextMember + 1
                Used(i) = False
            Else
                SavePermutation SetMembers()
            End If
        End If
    Next i
     
    If NextMember = 1 Then
        SavePermutation SetMembers(), True
        Erase SetMembers
        Erase Used
    End If
     
End Sub 'AddPermutation
 
Private Sub AddCombination(Optional PopSize As Integer = 0, _
    Optional SetSize As Integer = 0, _
    Optional NextMember As Integer = 0, _
    Optional NextItem As Integer = 0)
     
    Static iPopSize As Integer
    Static iSetSize As Integer
    Static SetMembers() As Integer
    Dim i As Integer
     
    If PopSize <> 0 Then
        iPopSize = PopSize
        iSetSize = SetSize
        ReDim SetMembers(1 To iSetSize) As Integer
        NextMember = 1
        NextItem = 1
    End If
     
    For i = NextItem To iPopSize
        SetMembers(NextMember) = i
        If NextMember <> iSetSize Then
            AddCombination , , NextMember + 1, i + 1
        Else
            SavePermutation SetMembers()
        End If
    Next i
     
    If NextMember = 1 Then
        SavePermutation SetMembers(), True
        Erase SetMembers
    End If
     
End Sub 'AddCombination
 
Private Sub SavePermutation(ItemsChosen() As Integer, _
    Optional FlushBuffer As Boolean = False)
     
    Dim i As Integer, sValue As String
    Static RowNum As Long, ColNum As Long
     
    If RowNum = 0 Then RowNum = 1
    If ColNum = 0 Then ColNum = 1
     
    If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
        If BufferPtr > 0 Then
            If (RowNum + BufferPtr - 1) > Rows.Count Then
                RowNum = 1
                ColNum = ColNum + 1
                If ColNum > 256 Then Exit Sub
            End If
             
            Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
            = Application.WorksheetFunction.Transpose(Buffer())
            RowNum = RowNum + BufferPtr
        End If
         
        BufferPtr = 0
        If FlushBuffer = True Then
            Erase Buffer
            RowNum = 0
            ColNum = 0
            Exit Sub
        Else
            ReDim Buffer(1 To UBound(Buffer))
        End If
         
    End If
     
     'construct the next set
    For i = 1 To UBound(ItemsChosen)
        sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
    Next i
     
     'and  save it in the buffer
    BufferPtr = BufferPtr + 1
    Buffer(BufferPtr) = Mid$(sValue, 3)
End Sub 'SavePermutation


----------------------------------------------
| 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
----------------------------------------------
| 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 |
----------------------------------------------
| 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 |
----------------------------------------------
| 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 |
----------------------------------------------
| 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 |
----------------------------------------------
| 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 |
----------------------------------------------
| 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 |
----------------------------------------------
| 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 |
----------------------------------------------
| 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | |
----------------------------------------------

Please paste the above data in notepad with COURIER NEW font to view it
clearly.

I have a GRID in Excel like the one shown above. If you look at a
combination of 9 numbers " 9 17 25 33 41 49 57 65 73" You will notice
that these numbers do not intercept horizontally or vertically with any
other number within the combination.

Easier clarification: Take the first number in the combination "9" and
see vertically downwards (9th column), you would notice that any other
number from that COLUMN is not present in the combination and if you
see towards left (1st row), you would notice that any other number from
that ROW is not present in the combination

I would like to know how many such combinations of 9 could be made with
the above criteria.

Other examples for a combination of 9 numbers
2 10 21 32 40 51 61 72 80
8 9 16 33 41 49 57 65 73

I found a macro written by Myrna Larson that creates combinations. Here
is a link
http://www.mrexcel.com/board2/viewtopic.php?t=179001

Can this macro be modified to suit my needs?

On 2/22, Myrna Larson posted the following message. What is the proper
etiquette for requesting this implementation, or perhaps Myrna might be
persuaded to post the code?

"BTW, if the only function you need from the ATP is XIRR, I have written my
own
version, which gives the same results and runs quite a bit faster."

Thank you.

Hello,

I've been attempting to use XIRR with non contiguous cells, in Excel 97, but
without success.

My data (investment fund Unit Prices) is arranged in columns (dates in A,
values in B, sorted in ascending order) and I'm wanting to calculate
annualized returns over various periods.

My lack of success lead to a very long search of the newsgroup archives, as
well as other sources. I finally found out that it's not possible to use
XIRR 'directly' where the cells are non contiguous, but there were a couple
of workarounds suggested. One, a UDF from Harland Grove (submitted by Ron
Rosenfeld), and the second a formula using Offset, from Domenic. I also
came across the Function XXIRR, submitted by Myrna Larson.

However, I still have a couple of questions related to this and would
appreciate any feedback that people can offer.

1. The UDF works fine but has the drawback that the non-contiguous ranges
must be named. This is quite laborious when there are about 2000 data sets
and one wants to do many XIRR comparisons. Also, at least one of the values
for XIRR must be a negative and therefore the UDF doesn't work on my
original data as they are all positive values. Is there any way that the
UDF can be modified to change one value (the first, corresponding to the
earliest date, presumably) to a negative?

===========================
Function myxirr( _
v As Variant, _
d As Variant, _
Optional g As Double = 0 _
) As Variant
'-------------------------------------------------------
'this udf requires an explicit reference to APTVBAEN.XLA
'if v and/or d represent non-contiguous ranges, they should be
'NAME'd
'-------------------------------------------------------
Dim vv As Variant, dd As Variant, X As Variant, i As Long

If TypeOf v Is Range Then
ReDim vv(1 To v.Cells.Count)
i = 0
For Each X In v
i = i + 1
vv(i) = X.Value
Next X
Else
vv = v
End If

If TypeOf d Is Range Then
ReDim dd(1 To d.Cells.Count)
i = 0
For Each X In d
i = i + 1
dd(i) = X.Value
Next X
Else
dd = d
End If

myxirr = IIf(g <> 0, xirr(vv, dd, g), xirr(vv, dd))
End Function
===========================

2. Another query I found posted, but for which I didn't see any reply, also
applies to my situation. Any help would be most appreciated. Namely:

> I use the XIRR function regularly but would like to input relative
> references instead of always using arrays or constants (as in the Help
> example) but if I try this I get an error. Specifically I would like
> to do something like this: xirr({-b1,b2},{a1,a2}). This way I can
> calculate the period return from a list of positive values (e.g.
> balances as of a certain date).

The '-b1' causes the error, with dates in column A and values in column B.

3. From a thread titled "XIRR in VBA" - by Myrna Larson

Option Explicit

Const MaxChange As Double = 0.00000001
Const MaxTries As Long = 100

Enum ArrayDims '07/26/2003
NotArray = 0
SingleDim = 1
Horizontal = 2
Vertical = 3
Rectangular = 0
End Enum

etc. etc.

When I paste the code into the VBE the lines "Enum ArrayDims" and "End Enum"
are both highlighted in red.

Does this mean that "Enum" is not available in Excel 97?

If it's not, is there any alternative that would allow use of this function
in Excel 97?

Apologies for the length of this post, but I thought it was best to pose all
the questions at the same time since they're related.

Regards,

John

THREAD SOLVED...and very well too

Hi All,

I saw a few posts on permutations/combinations functions and pointers to the Myrna Larson toolkit/workbook but I think my need is slightly different from that use case (maybe not!)

I need to find all 3, 4 and 5 letter permutations based on 5-8 musical notes as input. FYI the permutations will be chords.

i.e. C, D, E, F, Ab, Bb, B as an input musical scale input would yield

All three note combos :
C,D,E
C,D,F
C, D, Ab
....
all 4 note combos
C,D,E,F
C,D,E,Ab

all 5 note combos
C,D,E,F,Ab
C,D,E,F,Bb
...

I'd like to structure the sheet as having 12 columns (1 for each note within an octave) with the combo placed under the right column i.e. C goes in 1, Eb in 4.

any help on this matter much appreciated

Drongomala


No luck finding an answer? You could always try Google.