Need help about this question!

[Eldrine]

Hi everyone

Can you solve this question on excel vba?

When a number divided its multiplier, at least one of its prime multiplier repeats we call it double multiplier. What is the smallest positive integer with itself and its four neighbors (2 before, 1 before, number itself, 1 after, 2 after)?

If this question asked for the number and 2 neighbors (1 before, number itself, 1 after) answer would be 49:

48=2*2*2*2*3
49=7*7
50=2*5*5

Thank you so much. I need this question solved on excel vba. Sorry for bad English

[werafa]

I don't understand what you are trying to achieve, but it sounds like a goal seek or monte-carlo analysis.

I would create the formula in excel, program each of the formula variables as vba variables, throw numbers at the formula, and record every successful combination.
look up 'monte carlo analysis in excel' to understand what I mean.

in vba it should be as simple as:

range("B1").value = Var1
Range("C1").value = Var2
etc

if Range("A1").value 'is a valid answer then
' write Var1, Var2 etc in list of valid inputs

[Eldrine]

I just wanted to do that determine 5 consecutive numbers :

Dim i As Integer
For i = 1 To 10000
ThisWorkbook.Sheets("Sayfa1").Cells(2, 1).Value = i
ThisWorkbook.Sheets("Sayfa1").Cells(4, 1).Value = i + 1
ThisWorkbook.Sheets("Sayfa1").Cells(6, 1).Value = i + 2
ThisWorkbook.Sheets("Sayfa1").Cells(8, 1).Value = i + 3
ThisWorkbook.Sheets("Sayfa1").Cells(10, 1).Value = i + 4
Next


After that every number should diveded fully. For example if i number = 10000. lets divide it by 2. Answer is 5000 and its integer. Fully divided. After that, 5000 can divided to 2 once more. I want to write down these 2s down of cell.If there is same dividers like two 2 , I want to add 1 to right of my number. Every number from beginning to 10000 should be evaluated like that way. I dont know I can explain this but I really need help

Thank you so much

[mdmackillop]

Can you post a workbook with a few numbers showing the result you require. Go Advanced/Manage Attachments

[Eldrine]

I posted it

[mdmackillop]

Option Explicit
Sub Test()
Dim Num As Long, i As Long, j As Long
Dim Rslt As Long
Application.ScreenUpdating = False
For Num = 3 To 10000
    Cells(2 * Num, 1) = Num
    Cells(2 * Num, 1).Font.ColorIndex = 3
    Rslt = Num
    i = 2
    j = 0
    Do
        If Rslt Mod i = 0 Then
            Rslt = Rslt / i
            j = j + 1
            Cells(2 * Num + 1, j) = i
        Else
            i = i + 1
        End If
    Loop Until Rslt = i
    Cells(2 * Num + 1, j + 1) = i
Next Num
Application.ScreenUpdating = True
Application.Goto Cells(Num, j + 1)
End Sub

[Eldrine]

Thank you

It isnt wrong.At that point when we find numbers dividers we need to find the number which its dividers at least 1 equal numbers. I know my question answer is 846;

844=2*2*211 ( at least 1 same number = 2)
845=5*13*13 (at least 1 same number = 13)
846=2*3*3*47 (at least 1 same number = 3)
847=7*11*11 (at least 1 same number = 11)
848=2*2*2*2*53 ( at least 1 same number 2)

All I want excel to find smallest positive integer with itself and its four neighbors (2 before, 1 before, number itself, 1 after, 2 after) . 5 consecutive numbers that has at least 1 same divider. It should start 1 to 10000 for example. If number has 1 same divider (for example 847 = 7*11*11 two 11)

I dont know I can explain right. I am so sorry. I try to do but I cant. I hope I told it right.

Thank you so much

[mdmackillop]

Option Explicit
Sub Test2()
Dim Num As Long, i As Long, j As Long, Limit As Long
Dim Rslt As Long
Dim arr
Dim x


Limit = 10000


ReDim arr(1 To Limit)
For Num = 3 To Limit
    Rslt = Num
    i = 2: j = 0
    Do
        If Rslt Mod i = 0 Then
            Rslt = Rslt / i
            j = j + 1
            If j > 1 Or Rslt = i Then
                arr(Num) = 1
                Exit Do
            End If
        Else
            i = i + 1
            j = 0
        End If
      Loop Until Rslt = i
    
    If Num > 8 Then
        x = arr(Num - 4) + arr(Num - 3) + arr(Num - 2) + arr(Num - 1) + arr(Num)
        If x > 4 Then
            MsgBox Num - 2
            Exit Sub
        End If
    End If
Next Num
End Sub