Trying to sum 2^i from i=0 to i=n on VBA. Where n is an entered value by the user each time
I can get it to do each term individually but its not summing.
Sub Button1()
Dim n As Single
n = InputBox("Enter a value for n")
Dim array as
Dim CSeriesSum As Double
ActiveCell.Value = WorksheetFunction.SeriesSum(Arg1:=2, Arg2:=n, Arg3:=1, Arg4:=1:n)
End Sub
I expect it to return for eg. 1 if n=0, 3 if n=1, 7 if n=2 etc.
Maybe try this loop:
Sub Button1()
Dim n As Single
n = InputBox("Enter a value for n")
Dim val As Long
val = 0
For i = 0 To n
val = val + 2 ^ i
Next
ActiveCell.Value = val
End Sub
In addition to the loop-based approach, you can use the fact that the series
1 + 2 + 2^2 + ... + 2^n + ...
is a geometric series whose partial sums can be expressed in closed-form. In this case the partial sum that you are evaluating is equal to 2^(n+1)-1. For example, if n = 3, it is easy to verify that
1 + 2 + 4 + 8 = 15 = 16-1 = 2^4 - 1
This leads to the following code:
Sub Button1()
Dim n As Long
n = InputBox("Enter a value for n")
ActiveCell.Value = 2 ^ (n + 1) - 1
End Sub
Related
Task: A prime number (or a prime) is a natural number greater than 1 that has no positive
divisors other than 1 and itself. Here are the first few prime numbers:
2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31...
Define a function that, given an integer n, determines the first n prime
numbers.
Problem: I am currently getting the primes between 0-n but not n prime numbers.
My code is:
Sub MACRO()
Z = InputBox("enter number")
Dim x As Long, n As Long, i As Long, PrimeNumber As Long
x = 0
With ActiveSheet
For n = 1 To Z
For i = 2 To n - 1
If n Mod i = 0 Then
x = 0
Exit For
Else
x = 1
End If
Next
If x = 1 Then
PrimeNumber = PrimeNumber + 1
.Cells(PrimeNumber, 1) = n
End If
Next
End With
End Sub
When searching for Primes, you speed thing up by observing:
You only need to test Odd numbers
You can exclude a test for divisibility by 2
You only need to test for divisibility by previously found prime numbers
You only need to test up to the square root of the candidate number
Something like this
Sub FindPrimes(NumPrimes As Long, Primes() As Long)
Dim Candidate As Long, Factor As Long
Dim idxP As Long
Dim IsPrime As Boolean
Dim i As Long
ReDim Primes(1 To NumPrimes)
Primes(1) = 2
Primes(2) = 3
idxP = 3
Candidate = 3
Do While idxP <= NumPrimes
Candidate = Candidate + 2
i = 2
IsPrime = True
Do
Factor = Candidate \ Primes(i)
' Factor < Primes(i) implies Primes(i) > Sqrt(Candidate)
If Factor < Primes(i) Then
Exit Do
End If
If Factor * Primes(i) = Candidate Then
IsPrime = False
Exit Do
End If
i = i + 1
Loop
If IsPrime Then
Primes(idxP) = Candidate
idxP = idxP + 1
End If
Loop
End Sub
Use it like this
Sub Demo()
Dim Primes() As Long
Dim Num As Long
FindPrimes Num, Primes
' Primes is now an array of the first Num primes
End Sub
On my hardware, this finds the first 10,000 primes in 50ms (FWIW, compared to Foxfire's answer which takes 10s)
For this code to work, you need to add a reference to Microsoft Scripting Runtime from Tools->References
Iterate from 1 to number studied.
Dim n As Integer
Dim i As Double
Dim MyStart As Double
Dim zz As Integer
Dim MyPrimes As Dictionary
Dim MyKey As Variant
n = 10 'change this to get n prime numbers
Set MyPrimes = New Dictionary
zz = 0
i = 1
Do Until zz = n
For MyStart = 1 To i Step 1
If i / MyStart = Int(i / MyStart) Then
'check if it's prime
If MyStart = i Then
'it's prime. we check the dictionary. If it does not exist, we add it and update count
If MyPrimes.Exists(MyStart) = False And MyStart<>1 Then
MyPrimes.Add MyStart, MyStart
zz = MyPrimes.Count
End If
Else
'it is not prime. Quit Loop if divisor it's not 1
If MyStart <> 1 Then Exit For
End If
End If
Next MyStart
i = i + 1
Loop
For Each MyKey In MyPrimes.Keys
Debug.Print MyPrimes(MyKey)
Next MyKey
MyPrimes.RemoveAll
Set MyPrimes = Nothing
In the debug windows i Get:
1
2
3
5
7
11
13
17
19
23
Just change n and test it. Hope this helps
UPDATE: As #PeH said, 1 is not prime, my bad,so I updated code to ignore number 1 :)
UPDATE 2: As #PeH suggested, you can also Dim MyPrime As Object and then use late binding Set MyPrime = CreateObject("Scripting.Dictionary").
Advantage: you don't need to add Microsoft Scripting Runtime and if you use it on different computers with different versions of the runtime it will still work.
Disatvantage: you lose intelli sense in the VBA editor (for this object only).
In case you want to know how dictionaries work: Excel VBA Dictionary– A Complete Guide
I have in Column K:
K8 is 6384 i.e. =SUM(J1:J8)
K9 is 2598 i.e. =SUM(J2:J9)
K10 is 12176 i.e =SUM(J3:J10)
:
:
K5488
up to K5488 (No numbers in sequence, all different numbers)
The largest number appearing in K is 1 400 000.
I need in Column M: The prime factors of each number in K
e.g. K8 is 6384 then M8 should be 2,2,2,2,3,7,19
k9 is 2598 then M9 should be 2,3,433 etc.
I found the following code by John Coleman on your site (Mar 28) which tested well, but seeing I have no programming knowledge, I don't know how to modify it to use in my columns K & M setup.
Here's the sample code:
Function Factor(ByVal n As Long, Optional FirstTrial As Long = 2) As String
Dim i As Long
Dim t As Long
Dim limit As Long
Dim rest As String
Dim s As String
If n = 1 Then
Factor = n
Exit Function
End If
limit = Int(Sqr(n))
t = FirstTrial
Do While t <= limit
If n Mod t = 0 Then
rest = Factor(n / t, t)
If rest <> "1" Then
s = t & "," & rest
End If
Factor = s
Exit Function
Else
If t = 2 Then t = 3 Else t = t + 2
End If
Loop
'if we get here:
Factor = n
End Function
Function PrimeOrFactor(n As Long) As String
Dim s As String
s = Factor(n)
If n = 1 Then
PrimeOrFactor = "Neither"
ElseIf (s) = Trim(n) Then
PrimeOrFactor = "Prime"
Else
PrimeOrFactor = s
End If
End Function
Tested like:
Sub test()
Dim i As Long
For i = 1 To 20
Cells(i, 1) = i
Cells(i, 2) = PrimeOrFactor(i)
Next i
End Sub
The function you provided is a udf (user defined function) to be used in your worksheet.
If you put the functions you provided in a normal code module, you can enter the following in your worksheet in M8:
=Factor(K8)
and copy that function down to your desired range.
I have of integers in Col A and in col B i want to show result 'Prime' if it doesn't have further factors for the number itself. This goes like this if the number for example is 37 result will be 'Prime' and if its 44 then result will be 2x2x11. How can i do this using excel formula? Screen shot :
Disclaimer: code below is ported from this very useful VB.NET example
Option Explicit
Sub Test()
Debug.Print FindFactors(2)
Debug.Print FindFactors(3)
Debug.Print FindFactors(11)
Debug.Print FindFactors(12)
Debug.Print FindFactors(13)
Debug.Print FindFactors(16)
Debug.Print FindFactors(17)
Debug.Print FindFactors(24)
Debug.Print FindFactors(25)
Debug.Print FindFactors(11234)
Debug.Print FindFactors(67894)
End Sub
Function FindFactors(lngNumber As Long) As String
Dim collFactors As Collection
Dim lngFactor As Long
Dim lngCounter As Long
Dim strFactors As String
Dim strFactor As String
Set collFactors = New Collection
' Take out the 2s.
Do While (lngNumber Mod 2 = 0)
collFactors.Add 2
lngNumber = lngNumber / 2
Loop
' Take out other primes.
lngFactor = 3
Do While (lngFactor * lngFactor <= lngNumber)
If (lngNumber Mod lngFactor = 0) Then
' This is a factor.
collFactors.Add lngFactor
lngNumber = lngNumber / lngFactor
Else
' Go to the next odd number.
lngFactor = lngFactor + 2
End If
Loop
' If num is not 1, then whatever is left is prime.
If lngNumber > 1 Then
collFactors.Add lngNumber
End If
' make a string out of collection
strFactors = ""
If collFactors.Count = 1 Then
strFactors = "Prime"
Else
For lngCounter = 1 To collFactors.Count
strFactors = strFactors & collFactors(lngCounter)
If lngCounter < collFactors.Count Then
strFactors = strFactors & "x"
End If
Next lngCounter
End If
FindFactors = strFactors
End Function
Gives an output of:
Prime
Prime
Prime
2x2x3
Prime
2x2x2x2
Prime
2x2x2x3
5x5
2x41x137
2x83x409
Can be used in a worksheet:
Here is a somewhat straightforward recursive version. It is based on the idea that once you identify a factor you divide the number by that factor and then turn your attention to factoring the rest.
Function Factor(ByVal n As Long, Optional FirstTrial As Long = 2) As String
Dim i As Long
Dim t As Long
Dim limit As Long
Dim rest As String
Dim s As String
If n = 1 Then
Factor = n
Exit Function
End If
limit = Int(Sqr(n))
t = FirstTrial
Do While t <= limit
If n Mod t = 0 Then
rest = Factor(n / t, t)
If rest <> "1" Then
s = t & "x" & rest
End If
Factor = s
Exit Function
Else
If t = 2 Then t = 3 Else t = t + 2
End If
Loop
'if we get here:
Factor = n
End Function
Function PrimeOrFactor(n As Long) As String
Dim s As String
s = Factor(n)
If n = 1 Then
PrimeOrFactor = "Neither"
ElseIf (s) = Trim(n) Then
PrimeOrFactor = "Prime"
Else
PrimeOrFactor = s
End If
End Function
Tested like:
Sub test()
Dim i As Long
For i = 1 To 20
Cells(i, 1) = i
Cells(i, 2) = PrimeOrFactor(i)
Next i
End Sub
Output:
Using LET and dynamic arrays allows for the following without VBA.
=LET(x, SEQUENCE(A1),
factors, FILTER(x, MOD(A1,x) = 0),
factorMatrix, 1 * (MOD(factors, TRANSPOSE(factors)) = 0),
primeFactors, FILTER(factors, MMULT(factorMatrix, factors ^ 0) = 2),
primeFactorList, IF(MOD(A1, primeFactors ^ SEQUENCE(1, 20)) = 0, primeFactors, ""),
factorProduct, TEXTJOIN("x",, primeFactorList),
IF(A1 = 1, "Neither", IF(factorProduct=A1&"","Prime",factorProduct)))
It works for numbers up to 2^20.
A slight modification to the excellent code of John Coleman above, using Mod with Doubles included below, will allow factoring integers up to Excel's 15 digit limit. Numbers with large factors may be noticeably slower. For example, 562,951,983,465,953 factored correctly as 16,777,259 x 33,554,467 in about 5 seconds on a Core i3.
Function Factor(ByVal n As Double, Optional FirstTrial As Double = 2) As String 'Changed
Dim i As Long
Dim t As Double 'Changed
Dim limit As Long
Dim rest As String
Dim s As String
If n = 1 Then
Factor = n
Exit Function
End If
limit = Int(Sqr(n))
t = FirstTrial
Do While t <= limit
If FMod(t, n) = 0 Then 'Changed
.
.
.
Public Function FMod(a As Double, b As Double) As Double
FMod = a - Fix(a / b) * b
'http://en.wikipedia.org/wiki/Machine_epsilon
'Unfortunately, this function can only be accurate when `a / b` is outside [-2.22E-16,+2.22E-16]
'Without this correction, FMod(.66, .06) = 5.55111512312578E-17 when it should be 0
If FMod >= -2 ^ -52 And FMod <= 2 ^ -52 Then '+/- 2.22E-16
FMod = 0
End If
End Function
I'm struggling with a complex excel problem, and I would be amazed by any solution.
I have a table with 4 columns and the following values
The highest |13|12|12|12|
The two highest|11|12|11|11|
The two highest|12|12|12|12|
|12|11|11|11|
|12|11|11|11|
|12|11|11|11|
My problem requires from the first three rows to select the highest respectively the two highest values. Over the complete matrix there should be a sum of 12 values.
The required 5 plus whatever are the remaining 7 highest values. My current approach is to do a sum of the required rows and add the rest together, but that is obviouly not working.
|13|12|12|12|[MAX(B10:E10)]13|
|11|12|11|11|[LARGE(B11:E11;1)+LARGE(B11:E11;2)23|
|12|12|12|12|[LARGE(B12:E12;1)+LARGE(B12:E12;2)24|
|12|11|11|11|
|12|11|11|11|
|12|11|11|11|
Any ideas or suggestions are highly appreciated. Also a more understandable title for references would be great. Thanks!
Explanation:
It's sloppy VBA, but this works and the structure is generally expandable if you need it to be. You can just paste this in a VBA module, run Sum57(), and the result will be in the debug window (Ctl + G). To modify this for other array sizes, change the following :
the size of the used array in line 1
the values of arrR and arrC in lines 5 and 6 which define the start of the array
the pattern of the function calls in the body of Sum57()
The base pattern is:
For i = 1 To N
x = x + LargeOfRange([rStart], [rEnd], [cStart], [cEnd])
Next
where N is top N largest numbers from the range.
VBA:
Public used(5, 3) As Boolean
Public arrR, arrC As Integer
Public Sub Sum57()
arrR = 10
arrC = 2
For a = LBound(used, 1) To UBound(used, 1)
For b = LBound(used, 2) To UBound(used, 2)
used(a, b) = False
Next
Next
Dim x As Integer
x = x + LargeOfRange(10, 10, 2, 5)
For i = 1 To 2
x = x + LargeOfRange(11, 11, 2, 5)
Next
For i = 1 To 2
x = x + LargeOfRange(12, 12, 2, 5)
Next
For i = 1 To 7
x = x + LargeOfRange(10, 15, 2, 5)
Next
Debug.Print x
End Sub
Public Function LargeOfRange(rStart As Integer, rEnd As Integer, _
cStart As Integer, cEnd As Integer) As Integer
On Error GoTo SkipVal
Dim l, x, xR, xC As Integer
x = 0
For r = rStart To rEnd
For c = cStart To cEnd
If x < Cells(r, c).Value And used(r - arrR, c - arrC) = False Then
xR = r
xC = c
x = Cells(r, c).Value
End If
Next
Next
used(xR - arrR, xC - arrC) = True
LargeOfRange = x
Exit Function
SkipVal:
LargeOfRange = 0
End Function
Why not just extend the range and add more elements to the Large() calc?
=LARGE(B13:E15,1)+LARGE(B13:E15,2)+LARGE(B13:E15,3)+LARGE(B13:E15,4)+
LARGE(B13:E15,5)+LARGE(B13:E15,6)+LARGE(B13:E15,7)
This returns 80
sorry for the ambiguous title. I'm not quite sure how to name what I'm trying to do.
I have data in a worksheet that looks like this:
I would like to search for the smallest number in the range and write out the name on the y axis and the number. It then ignores this number and searches for the smallest number on the x axis as well. In that same row, it searches for the smallest value horizontally, excludes the number and then looks vertically as well. It continues this way until all possibilities are exhausted. Is this possible with Excel?
A sample output will be:
y5 : 40
x3: 60
y3: 90
x4: 80
y2 : 85
x3: 75
y1 : 70
and so on.
Interesting problem. You should be able to modify the following. To run it you need to include a reference to Microsoft Scripting Runtime (Under Tools/References in the VBA editor) since it uses a dictionary data structure -- the natural choice to keep track of already picked numbers:
'The following code assumes than Nums is a 1-based 2-dimensional array
Function MinPath(Nums As Variant) As Variant
Dim counter As Long
Dim mins As Variant
Dim PickedNums As New Dictionary
Dim i As Long, j As Long, m As Long, n As Long
Dim report As String
Dim direction As String
Dim num As Variant
Dim min As Variant, min_i As Long, min_j As Long
m = UBound(Nums, 1)
n = UBound(Nums, 2)
ReDim mins(1 To m * n)
min = Nums(1, 1)
min_i = 1
min_j = 1
For i = 1 To m
For j = 1 To n
If Nums(i, j) < min Then
min = Nums(i, j)
min_i = i
min_j = j
End If
Next j
Next i
PickedNums.Add min, 0
counter = 1
mins(counter) = Array(min_i, min_j, min)
direction = "vertical"
min = Empty
Do While True
If direction = "vertical" Then
For i = 1 To m
num = Nums(i, min_j)
If Not PickedNums.Exists(num) Then
If IsEmpty(min) Then
min = num
min_i = i
ElseIf num < min Then
min = num
min_i = i
End If
End If
Next i
If IsEmpty(min) Then
ReDim Preserve mins(1 To counter)
MinPath = mins
Exit Function
Else
PickedNums.Add min, 0
counter = counter + 1
mins(counter) = Array(min_i, min_j, min)
direction = "horizontal"
End If
Else
'direction = horizontal case
For j = 1 To n
num = Nums(min_i, j)
If Not PickedNums.Exists(num) Then
If IsEmpty(min) Then
min = num
min_j = j
ElseIf num < min Then
min = num
min_j = j
End If
End If
Next j
If IsEmpty(min) Then
ReDim Preserve mins(1 To counter)
MinPath = mins
Exit Function
Else
PickedNums.Add min, 0
counter = counter + 1
mins(counter) = Array(min_i, min_j, min)
direction = "vertical"
End If
End If
min = Empty
Loop
End Function
The function repeatedly searches a either a row or a column (depending on the search direction) to find the smallest non-picked number. At the beginning of each pass the variable min is set to Empty until a non-picked number is encountered. If after a pass min is still Empty the function returns. This function returns an array of arrays where each array is of the form Array(i,j,min) (e.g. the values (5,3,40) in the first step). VBA's Array function returns a 0-based array so the i (row) coordinate is at index 0 and the j coordinate is at index 1. What you do with this data is up to you. For example:
Sub test()
Dim i As Long, n As Long
Dim mins As Variant
mins = MinPath(Range("B2:F6").Value)
n = UBound(mins)
For i = 1 To n
If i Mod 2 = 1 Then 'odd step
Range("A7").Offset(i).Value = "y" & mins(i)(0) & ":"
Else 'even step
Range("A7").Offset(i).Value = "x" & mins(i)(1) & ":"
End If
Range("B7").Offset(i).Value = mins(i)(2)
Next i
End Sub
Which results in: