vba Collatz conjecture

[Imran Azam]

Hi Guys

I am trying to create a macro which follows the Collatz Conjecture( basically says: Pick any natural number n. If n is even, take n and divide by 2. If n is odd, multiply n by 3 and add 1. Repeat this algorithm and regardless of what number you picked to begin with, you will always end at 1)

The macros needs to do the following

1) allow the user to type input number via an input box and also type Max number via another input box , both these number have to be positive number , if it isn't a positive number then need a message to appear saying please pick a positive number

2) the macro now needs to take the Collatz Conjecture maths and see if the number of steps taken to get the input number (to equal to1) is less than or equal to the max number inputted , if this is the case then a message box appears showing the the number of steps taken) . If the steps taken are higher than the max number give then return a message saying ' process didn't work'

for example if user insert the input number as 10 and max number as 7 , and this input number ( 10) needs 5 steps ( Collatz Conjecture) to get to the number 1 then a message return would be " 5".
However for example if the input number 10 needed 8 steps to get to the number 1 then message would return ' process didn't work' as this is more than the max number.

can any one help with this?

i did some code but made a mess of it , it isnt really working its shown below

Sub collat2()
n = InputBox("type in a number ")
am = 0
Do While n <> 1
    If n Mod 2 = 0 Then
        n = n / 2
    Else
        n = n * 3 + 1
    End If
If n > am Then
    Z = am
End If
x = x + 1
Dim ligne As Integer
'Cells(1, 1).Value = "Trip"
Cells(x, 1).Value = n
Loop
'Cells(1, 2).Value = "Steps"
Cells(x, 2).Value = x
'Cells(1, 3).Value = "Maximal altitude"
Cells(x, 3).Value = am
End Sub

thank you for any help

 

[Peter_SSs]

i dont need the figures posted onto the worksheet

In that case, just this should do

Sub collat2_v3()
  Dim n As Long, MaxTries As Long, k As Long
  
  Do
    n = InputBox("Enter a positive number to test")
    If n <= 0 Then MsgBox "Number must be positive"
  Loop Until n > 0
  Do
    MaxTries = InputBox("Enter a positive number for maximum number of tries")
    If MaxTries <= 0 Then MsgBox "Number must be positive"
  Loop Until MaxTries > 0
  Do Until n = 1 Or k = MaxTries
    n = IIf(n Mod 2, n * 3 + 1, n / 2)
    k = k + 1
  Loop
  MsgBox IIf(n = 1, "Steps = " & k, "Process didn't work")
End Sub

 

[GWteB]

My submission, with some built-in safeguards, would look something like this:

Sub Collatz()

    Dim Altitude As Currency, MaxSteps As Currency, Steps As Currency, n As Currency
    Dim Btn As Long, MsgTitle As String, MsgPrompt As String

    MsgPrompt = "Input:" & vbTab & "@@@" & vbNewLine & _
                "Steps:" & vbTab & "@@" & vbNewLine & _
                "Altitude:" & vbTab & "@"

    On Error GoTo SUB_ERR
SUB_GETNUMBER:
    n = VBA.Int(Application.InputBox("Enter a number", Type:=1))
    If n <= 0 Then GoTo SUB_GETNUMBER

SUB_GETSTEPS:
    MaxSteps = VBA.Int(Application.InputBox("Enter amount of steps", Type:=1))
    If n <= 0 Then GoTo SUB_GETSTEPS

    MsgPrompt = VBA.Replace(MsgPrompt, "@@@", VBA.Format$(n, "#,###,###,###,##0"))
    Do
        n = IIf(n Mod 2 = 0, n / 2, n * 3 + 1)
        If n > Altitude Then Altitude = n
        Steps = Steps + 1
        If Steps = MaxSteps Then Exit Do
    Loop Until n = 1

SUB_ERR:
    If Steps = MaxSteps Then
        Btn = vbExclamation: MsgTitle = "Collatz:"
        MsgPrompt = "More then " & Steps & " steps required ..."
    Else
        MsgPrompt = VBA.Replace(MsgPrompt, "@@", Steps)
        If Err.Number = 0 Then
            MsgPrompt = VBA.Replace(MsgPrompt, "@", VBA.Format$(Altitude, "#,###,###,###,##0"))
            Btn = vbInformation: MsgTitle = "Collatz computation completed"
        Else
            MsgPrompt = VBA.Replace(MsgPrompt, "@", "N/A (greater than " & VBA.Format$(Altitude, "#,###,###,###,##0") & ")")
            Btn = vbCritical: MsgTitle = "Aborted in step " & Steps & " on computational overflow (error 6)"
        End If
    End If
    MsgBox MsgPrompt, Btn, MsgTitle
End Sub