Excel VBA Populate Rows

[Biz]

Dear All,

My code works well accept I need 40(DR) 50 (CR) which is not added properly.
Ignore rows 1-5 which I was testing.

In essence my code is copying and pasting (K7:K8) and I have split every entry to two components Debit (DR)
and Credit (CR). This code trying to generate accounting journals which works accept I'm stumped with adding 40(DR) 50 (CR) properly.

Before
Sheet1

*	A	B	C	D	E	F	G	H	I	J	K
1	*	59	*	*	*	*	*	*	*	*	*
2	*	59	*	*	*	*	*	*	*	*	*
3	*	250	*	*	*	*	*	*	*	*	*
4	*	250	*	*	*	*	*	*	*	*	*
5	*	*	*	*	*	*	*	*	*	*	*
6	*	*	*	*	*	*	*	*	*	*	*
7	*	*	*	*	*	*	*	*	*	*	250
8	*	*	*	*	*	*	*	*	*	*	1000
9	*	*	*	*	*	*	*	*	*	*	*
10	*	*	*	*	*	*	*	*	*	*	*
11	*	*	*	*	*	*	*	*	*	*	*
12	*	*	*	*	*	*	*	*	*	*	*
13	*	*	*	*	*	*	*	*	*	*	*
14	*	*	*	*	*	*	*	*	*	*	*
15	*	*	*	*	*	*	*	*	*	*	*
16	*	*	*	*	*	*	*	*	*	*	*
17	*	*	*	*	*	*	*	*	*	*	*
18	*	*	*	*	*	*	*	*	*	*	*
19	*	*	*	*	*	*	*	*	*	*	*
20	*	*	*	*	*	*	*	*	*	*	*
21	*	*	*	*	*	*	*	*	*	*	*
22	*	*	*	*	*	*	*	*	*	*	*
23	*	*	*	*	*	*	*	*	*	*	*

<tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4



After

if I input 2, vba input box then I get 4 rows which correct as 1 has two reps for DR and CR.
The problem 40 and 50 are missing in rows 8-9 and 12-13 which are debits and credits

Sheet1

*	A	B	C	D	E	F	G	H	I	J	K
1	*	59	*	*	*	*	*	*	*	*	*
2	*	59	*	*	*	*	*	*	*	*	*
3	*	250	*	*	*	*	*	*	*	*	*
4	*	250	*	*	*	*	*	*	*	*	*
5	*	*	*	*	*	*	*	*	*	*	*
6	40	250	*	*	*	*	*	*	*	*	*
7	50	250	*	*	*	*	*	*	*	*	250
8	*	250	*	*	*	*	*	*	*	*	1000
9	*	250	*	*	*	*	*	*	*	*	*
10	40	1000	*	*	*	*	*	*	*	*	*
11	50	1000	*	*	*	*	*	*	*	*	*
12	*	1000	*	*	*	*	*	*	*	*	*
13	*	1000	*	*	*	*	*	*	*	*	*
14	*	*	*	*	*	*	*	*	*	*	*

<tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4

    Sub aFinal()    Dim rngCopy As Range, rngPaste As Range
    Dim rCells As Range
    Dim xNum As Long
    Dim vValue As Variant
    Const cDebit As Integer = 40
    Const cCredit As Integer = 50
    
    '<~~ No of times min 2 rows for DR and CR. Can't do one side Journal
    xNum = Application.Max(InputBox("type no. of times you want to be repeat the range"), 1) * 2
    
 After   '<~~ Source Range to Copy
    Set rngCopy = Range("K7:K8")
    
    '<~~ Paste Range not a singe cell
    Set rngPaste = Range("B" & Range("B" & rows.Count).End(xlUp).Row).Offset(1, 0)
    
    '<~~ Loop thru and update cells
    For Each rCells In rngCopy.rows
        '<~~ Captures Value to pasted
        vValue = rCells.Value
        '<~~ Resize rngPaste based on rngCopy Rows
        With rngPaste
            .Offset(1, 0).Resize(xNum, 1).Value = vValue
            .Offset(1, -1).Resize(1).Value = cDebit
            .Offset(2, -1).Resize(1).Value = cCredit
        End With
        
        '<~~ Paste range offset by No of times which derives next row to paste
        Set rngPaste = rngPaste.Offset(xNum, 0)
    Next rCells
    
    
End Sub

Don't know how to add 40, 50 for every rep. Does someone know how to fix this problem?

Your help would be greatly appreciated.

Kind Regards

Biz

 

[Biz]

Guys,

I believe I sorted my problem. New code added is highlighted in red.

Sub aFinal()
    Dim rngCopy As Range, rngPaste As Range
    Dim rCells As Range
    Dim xNum As Long
    Dim vValue As Variant
    Dim i As Long
    Const cDebit As Integer = 40
    Const cCredit As Integer = 50
    
    '<~~ No of times -> min 2 rows for DR and CR. Can't do one sided journal
    xNum = Application.Max(InputBox("type no. of times you want to be repeat the range"), 1) * 2
    
    '<~~ Source Range to Copy
    Set rngCopy = Range("K7:K8")
    
    '<~~ Paste Range not a singe cell
    Set rngPaste = Range("B" & Range("B" & rows.Count).End(xlUp).Row).Offset(1, 0)
    
    '<~~ Loop thru and update cells
    For Each rCells In rngCopy.rows
        '<~~ Captures Value to pasted
        vValue = rCells.Value
        '<~~ Resize rngPaste based on rngCopy Rows
        With rngPaste
            .Offset(1, 0).Resize(xNum, 1).Value = vValue
            
           [COLOR=#ff0000] '<~~ Populate the DRs & CRs
            For i = 1 To xNum Step 2
                .Offset(i, -1) = cDebit
                .Offset(i + 1, -1) = cCredit
            Next i[/COLOR]

        End With
        
        '<~~ Paste range offset by No of times which derives next row to paste
        Set rngPaste = rngPaste.Offset(xNum, 0)
    Next rCells
        
End Sub

I'm not worried about Speedup code yet. Just wanted to check Excel VBA experts if I can streamline the code further.
Is it possible to streamline the code further?

'#### SpeedUp (False) - Speeds the VBA Code #####
'#### SpeedUp (True) - Slows down the VBA Code ####
Public Function SpeedUp(Optional bSpeed As Boolean = True)
With Application
    .ScreenUpdating = bSpeed 'Prevent screen flickering
    .Calculation = IIf(bSpeed, xlAutomatic, xlCalculationManual) 'Preventing calculation
    .DisplayAlerts = bSpeed 'Turn OFF alerts
    .EnableEvents = bSpeed 'Prevent All Events
End With
End Function

Kind Regards

Biz