vba code to insert blank line after two criteria and copy down criteria

[Jameswright]

Hello Forum

This is my first time using it. I'm very inexperienced when it comes to using vba. I'm hoping someone can assist me in writing macro vba code to accomplish the following. I have 4 columns: A (Account Code) B (Dr) C (Cr) D (Description) - as indicated below

Account Code Dr Cr Description
13410 10 0 Narration 1
13420 20 0 Narration 2
13430 30 0 Narration 3
13440 40 0 Narration 4

Every time the macro sees the account code of 13410 in column A a blank row needs to be inserted below and a corresponding credit amount in column C needs to be entered with say an account code of 98450 with the same narration.

Again every time the macro sees the account code of 13430 a blank row needs to be inserted and a corresponding credit line in column C needs to be entered with say an account of 97730 with the same narration.

Looking like this:

Account Code Dr Cr Description
13410 10 0 Narration 1
98450 0 10 Narration 1
13420 20 0 Narration 2
13430 30 0 Narration 3
97730 0 30 Narration 3
13440 40 0 Narration 4

I will be very much appreciated. I haven't found any forums with two criteria and hence hopeful someone can please assit.
Thanks heaps!!

James

[stnkynts]

Give this a whirl:

Sub Jameswright()
Dim ws As Worksheet:    Set ws = Sheets("Sheet1") 'make sure this matches your sheet name
Dim bNewRow As Boolean
Dim iCredit As Integer, i As Integer
Dim sCode As String

Application.ScreenUpdating = False

For i = ws.Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
    bNewRow = False
    Select Case ws.Range("A" & i).Value
        Case Is = "13410"
            bNewRow = True
            iCredit = 10
            sCode = "98450"
        Case Is = "13430"
            bNewRow = True
            iCredit = 30
            sCode = "97730"
    End Select
    
    If bNewRow = True Then
        ws.Range("A" & i).Offset(1).EntireRow.Insert Shift:=xlDown
        ws.Range("A" & i).Offset(1).Value = sCode
        ws.Range("B" & i).Offset(1).Value = 0
        ws.Range("C" & i).Offset(1).Value = iCredit
        ws.Range("D" & i).Resize(2, 1).FillDown
    End If
Next i

Application.ScreenUpdating = True

End Sub

[Jameswright]

Hey thank you for your swift response! I'm very grateful. I've tried using the code inserting it into a module. The example using account code 13430 resulted in the correct blank line being inserted with the credit account code 97730, however the example using account code 13410 did not produce the blank row and associated account code of 98450.

I noticed in the vba code (iCredit) that the amounts of $10, $20, $30 and $40 were hard coded into the macro. Can this be changed so that whatever $ amount is in column B will replicate in the credit column being column C.

I've tried to upload a spreadsheet but I'm not yet up on doing so.

[stnkynts]

I tested the code on a test workbook and it worked perfectly fine for me. In response to;

Can this be changed so that whatever $ amount is in column B will replicate in the credit column being column C.

This contradicts with your original post and is not clear as to what you really want. Submit an example workbook with a clear before and after example if you would like an amended response.

[Jameswright]

Hello & Good morning!

Thank you again for giving you're time ...It's very much appreciated!!.

I'm attempting to upload a spreadsheet to simulate the before and after result.
When I've run the macro only the rows with account code # 13430 has inserted a row below with the correct vba code of 97730. This did not
take place for account code 13410 which I'd also like to have a row inserted below with the account code of 98450.

The values in column B will vary, so I'm hoping that whatever value is say in cell B13 will then also replicate to cell C14. Perhaps by way of the
Offset function. The narration in row13 needs to be the same for row14 when the row is inserted.

On a separate issue when trying to run the vba code on another report that has all the detailed information a Run-time Error 13 appears.
I've attached this snipping tool picture as well indicating the issue.

I'm using Excel 2007 however I've tested the macro on Excel 2010 and the same issues have arisen.

Thank you so much for your time again. I hope I've been able to elaborate on my query.

Kind regards
James

[stnkynts]

Here is the amended code:

Sub Jameswright()
Dim ws As Worksheet:    Set ws = Sheets("Sheet1") 'make sure this matches your sheet name
Dim bNewRow As Boolean
Dim i As Integer
Dim sCode As String

Application.ScreenUpdating = False

For i = ws.Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
    bNewRow = False
    Select Case ws.Range("A" & i).Value
        Case Is = "13410"
            bNewRow = True
            sCode = "98450"
        Case Is = "13430"
            bNewRow = True
            sCode = "97730"
    End Select
    
    If bNewRow = True Then
        ws.Range("A" & i).Offset(1).EntireRow.Insert Shift:=xlDown
        ws.Range("A" & i).Offset(1).Value = sCode
        ws.Range("C" & i).Offset(1).Value = ws.Range("B" & i).Value
        ws.Range("D" & i).Resize(2, 1).FillDown
    End If
Next i

Application.ScreenUpdating = True

End Sub

On a separate issue when trying to run the vba code on another report that has all the detailed information a Run-time Error 13 appears.

What you have identified is not actually causing the error. I would have to see the file you referenced to identify the true issue.

[Jameswright]

Hi Again

I've upload a spreadsheet book2.xlsm which has the amended code. Unfortunately it's moved the amount destined for column C to column D. Thank you still for your efforts.

Very much appreciated.
James

[Jameswright]

My apologies

I've just realized the the updated book2.xlsm spreadsheet in my previous post wasn't set up with columns A B C D. The code is working all apart from the fact that account code 13410 in column A isn't having a line inserted below with the account code 98450 and the corresponding amount in column C of $1 and Naration 1 in column D. Else it's working great!

Perhaps it's someone unique on my end that's causing it not to function. book3.xlsm is attached.

Thanks a million for all your time & efforts ... really appreciated!!

[stnkynts]

It is because your previous attached Book1 didn't start at row 1. I assumed a header so didn't have it look at row 1. Just another reason why it is always a good idea to submit an example workbook that matches your real workbook as close as possible.

Change this line:

For i = ws.Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1

to this

For i = ws.Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1

[Jameswright]

Thank you very much. Your assistance has been much appreciated. And yes good advice to upload a spreadsheet.