Calculation in excel VBA

[mehidy1437]

Hi Experts,

I need help with the below issue.
I have data in A2:D5, I will divide each cell by a value let say 40 or anything.
What I need is a bit different, kindly see the below example.

2233.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1	S	M	L	XL		RESULT DIVIDED BY 40				REQUREMENT	ULTIMATE RESULT
2	1		80	40		0.025	0	2	1	IF RESULT IS <1 OR PRIME NUMBER, THEN IT WILL COUNT 1 FOR FULL ROW RANGE	1
3		70	1	120		0	1.75	0.025	3	IF RESULT IS >1 AND FRACTION NUMBER, THEN IT WILL COUNT 2 FOR EACH CELL	3
4	100	39	123	144		2.5	0.975	3.075	3.6		7
5	1	120	100	100		0.025	3	2.5	2.5		5
6											16
Sheet3 (2)

Cell Formulas
Range	Formula
F2:I5	F2	=A2/40
K3	K3	=1+2
K4	K4	=2+1+2+2
K5	K5	=1+2+2
K6	K6	=SUM(K2:K5)

*** Range is not fixed
***Range will select through an input box & divided value will also get from another input box
My ultimate result is to get 16 from this example in VB

 

[jasonb75]

See if this does what you need,

Sub test()
Dim d As Long, r As Long, i As Long, n As Double, p As Long, t As Long
Dim rng As Range, rw As Range, c As Range
d = InputBox("Divide by what?")
Set rng = Application.InputBox(prompt:="Please select range", Type:=8)

For Each rw In rng.Rows
    p = 0: r = 0
    For Each c In rw.Cells
        n = c.Value / d
           
        If n <> Int(n) Or n <= 1 Then
            p = 1
        Else
            For i = 1 To n
                If n Mod i = 0 Then
                    r = r + 2
                End If
            Next i
        End If
    Next c
        t = t + r + p
Next rw
    MsgBox t
End Sub

 

[mehidy1437]

First of all, many thanks for your kind response.
It worked for the first case, but when I increase the range,
it's giving me a result 22, but it should be 18.
Kindly see below.

2233.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1	S	M	L	XL		RESULT DIVIDED BY 40				REQUREMENT	ULTIMATE RESULT
2	1		80	40		0.025	0	2	1	IF RESULT IS <1 OR PRIME NUMBER, THEN IT WILL COUNT 1 FOR FULL ROW RANGE	1
3		70	1	120		0	1.75	0.025	3	IF RESULT IS >1 AND FRACTION NUMBER, THEN IT WILL COUNT 2 FOR EACH CELL	3
4	100	39	123	144		2.5	0.975	3.075	3.6		7
5	1	120	100	100		0.025	3	2.5	2.5		5
6	1	1	1	1		0.025	0.025	0.025	0.025		1
7	1	120	0			0.025	3	0	0		1
8
9											18
Sheet3 (2)

Cell Formulas
Range	Formula
F2:I7	F2	=A2/40
K3	K3	=1+2
K4	K4	=2+1+2+2
K5	K5	=1+2+2
K9	K9	=SUM(K2:K8)

 

[mehidy1437]

Some additional information,
only first row result is showing 5, but it s/b 1.
Ony 2nd row result is showing 5, but it s/b 3.
Only 3rd row result is showing 1, but it s/b 7.

 

[mehidy1437]

I have gained the correct result with the below changes.

Sub test()
Dim d As Long, r As Long, i As Long, n As Double, p As Long, t As Long
Dim rng As Range, rw As Range, c As Range
d = InputBox("Divide by what?")
Set rng = Application.InputBox(prompt:="Please select range", Type:=8)

For Each rw In rng.Rows
    p = 0: r = 0
    For Each c In rw.Cells
        n = c.Value / d
        'If n <> Int(n) Or n <= 1 Then
        If n = Int(n) Or n <= 1 Then
            p = 1
        Else
            'For i = 1 To n
            For i = 1 To 1
                If n Mod i = 0 Then
                    r = r + 2
                End If
            Next i
        End If
    Next c
        t = t + r + p
Next rw
    MsgBox t
End Sub

 

[jasonb75]

I did have a quick look earlier to try and find where it was going wrong, I wasn't seeing it but think I might have misunderstood part of the question.

Glad you got it working

 

[mehidy1437]

Thank you for the big help.

 

[mehidy1437]

I have added one more condition in it & its working fine.
This is just to let you know @jasonb75

Sub test()
Dim d As Long, r As Long, i As Long, n As Double, p As Long, t As Long, j As Long, k As Long
Dim rng As Range, rw As Range, c As Range
d = InputBox("Divide by what?")
Set rng = Application.InputBox(prompt:="Please select range", Type:=8)

For Each rw In rng.Rows
    p = 0: r = 0: k = 0
    For Each c In rw.Cells
        n = c.Value / d
        'If n <> Int(n) Or n <= 1 Then
        'If n = Int(n) Or n <= 1 Then
        If n <= 1 Then
            p = 1
            
         ElseIf n = Int(n) And n > 1 Then
            'For j = 1 To n
            For j = 1 To 1
                'If n Mod j = 0 Then
                    k = k + 1
                'End If
            Next j
    
        Else
            'For i = 1 To n
            For i = 1 To 1
                If n Mod i = 0 Then
                    r = r + 2
                End If
            Next i
        End If
    Next c
        t = t + r + k + p
Next rw
    MsgBox t
End Sub