Divide a number into two parts so that the resulting sum is equal to the input

Re: Divide a number into two parts so that the resulting sum is equal to the input

I dont know what logic to use for 4.99 to show as 2.5 & 2.49. I can get this to show as 2.495 and 2.495.

If that helps, use the below code and let me know if it works for you.

Sub M()
For i = 2 To 100 Step 2
If Range("A" & i).Value = "" Then
Exit For
End If
Range("B" & i) = Range("A" & i) / 2
Range("B" & i).Offset(1, 0).EntireRow.Insert
Range("B" & i).Offset(1, 0) = Range("A" & i) / 2
Next
End Sub

Re: Divide a number into two parts so that the resulting sum is equal to the input

Quote from zorin8488;750089

Thank you, its ok until now but the problem its that I need to show 2.50 and 2.49 instead of 2.495 and 2.495. I can use only 2 decimals. I need to split a cost in two parts with only two decimals.

Try this and let me know if it works for you.

Sub M()
    For i = 2 To 100 Step 2
        If Range("A" & i).Value = "" Then
            Exit For
        End If
        Range("B" & i) = Application.WorksheetFunction.RoundDown(Range("A" & i) / 2, 2)
        Range("B" & i).Offset(1, 0).EntireRow.Insert
        Range("B" & i).Offset(1, 0) = Application.WorksheetFunction.RoundUp(Range("A" & i) / 2, 2)
    Next
End Sub

Re: Divide a number into two parts so that the resulting sum is equal to the input

Quote from zorin8488;750091

YESS PERFECT!
Thank you very much and all the best!

Cheers, have fun

Re: Divide a number into two parts so that the resulting sum is equal to the input

An alternative
Data Column "A" results "B"

Sub N()
Dim Lst As Long, n As Long, R
Lst = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For n = Lst To 1 Step -1
    With Range("A" & n)
        .EntireRow.Insert
        If Len(.Value / 2) >= 5 Then
            R = .Value / 2 - Val(Left(.Value / 2, 4))
            .Offset(, 1) = .Value / 2 + R
            .Offset(1, 1) = .Value / 2 - R
        Else
            .Offset(, 1) = .Value / 2: .Offset(1, 1) = .Value / 2
        End If
    End With
Next n
Application.ScreenUpdating = True
End Sub

Re: Divide a number into two parts so that the resulting sum is equal to the input

Here's another variation

Sub test()
    Dim i As Long
    Dim x As Double
    With Range("A:A")
        For i = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
            With .Cells(i, 1)
                    .Offset(1, 0).EntireRow.Insert
                    .Offset(0, 1).Value = (.Value - (.Value \ 2))
                    .Offset(1, 1).Value = (.Value \ 2)
            End With
        Next i
    End With
End Sub