Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #2  
Old 01-27-2015, 11:04 PM
macropod's Avatar
macropod macropod is offline Combinations calculator in excel??? Macro?? Windows 7 64bit Combinations calculator in excel??? Macro?? Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,365
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

The following macro checks all cell pairs and triplets in the selected rows and reports any that add up to the value stored in the nominated target cell. Finding all the combinations that add up to the maximum possible that is less than the target value adds a great deal more complexity.
Code:
Sub FindSubSets()
Application.ScreenUpdating = False
Dim a As Long, b As Long, c As Long, d As Long
Dim Target As String, Output As String
Dim x As Long, y As Long, z As Long
If Selection.Rows.Count = 1 Or Selection.Columns.Count <> 1 Then
  MsgBox "Please select more than one row in a single column"
  Exit Sub
End If
a = ActiveCell.Row
b = ActiveCell.Column
c = Selection.Rows.Count + ActiveCell.Row - 1
d = 0
Target = InputBox("What is the address of the cell" & vbCrLf & "you want the numbers to add up to?")
Output = InputBox("What is the address of the first cell" & vbCrLf & "you want to output the results in?")
On Error GoTo Abort
Range(Output).Offset(d, 0) = ""
For x = a To c
  For y = x + 1 To c
  If Cells(x, b) + Cells(y, b) = Range(Target).Value Then
    Range(Output).Offset(d, 0) = Addr(x, b) + "+" + Addr(y, b)
    d = d + 1
  Else
    For z = y + 1 To c
    If Cells(x, b) + Cells(y, b) + Cells(z, b) = Range(Target).Value Then
      Range(Output).Offset(d, 0) = Addr(x, b) + "+" + Addr(y, b) + "+" + Addr(z, b)
      d = d + 1
    End If
    Next z
  End If
  Next y
Next x
Range(Output).Offset(d, 0) = ""
Abort:
Application.ScreenUpdating = False
End Sub
Private Function Addr(ByVal n As Long, ByVal m As Long) As String
  Addr = Cells(n, m).Address(False, False)
End Function
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
 



Similar Threads
Thread Thread Starter Forum Replies Last Post
Nested Looping all combinations of four items lhoffmeyer Excel Programming 1 11-30-2012 03:09 PM
Excel eBay Fee Calculator Formula rdonovan1 Excel 1 09-10-2012 07:37 PM
Separate the digits into 3 combinations Jasa P Word VBA 1 08-19-2012 11:04 PM
Excel Calculator Mandusin Excel 6 12-25-2010 07:34 AM
Age Calculator in MS Outlook 2002 SP3 turns Outlook 0 06-15-2010 12:26 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 11:27 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft