Insert row according cell value

[mrmaso]

Hello,
could me somebody help with macro which will add new rows according some cell. For example:

A DSH09306	B 1002444978	C 40	D 499	​ E​ 6:33	F	G
ZSH09325	1002445429	40	1 540	9:45	Pres	-
DBS01135	1002444826	40	1000	10:41	Pres	1
DBS01136	1002444827	40	1000	11:50	Pres
DBS01136	1002444978	40	1 000	12:57
DSH09335	1002444983	40	2 666	16:01	Pres
DSH09305	1002444977	40	1 499	17:41	Pres
DSH09306	1002444978	40	1 000	18:48	Pres

<colgroup><col><col><col span="3"><col><col></colgroup><tbody>
</tbody>

I would like to add row if in column F will be (Pres) and in add row will be copy previous row.

Thank you

 

[alansidman]

here is a vba solution

Sub mrmaso()
    Dim lr As Long, i As Long
    lr = Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = lr To 1 Step -1
        If Range("F" & i) = "Pres" Then
            Range("F" & i + 1).EntireRow.Insert
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "Completed"
End Sub

How to install your new code
Copy the Excel VBA code
Select the workbook in which you want to store the Excel VBA code
Press Alt+F11 to open the Visual Basic Editor
Choose Insert > Module
Edit > Paste the macro into the module that appeared
Close the VBEditor
Save your workbook (Excel 2007+ select a macro-enabled file format, like *.xlsm)


To run the Excel VBA code:
Press Alt-F8 to open the macro list
Select a macro in the list
Click the Run button

 

[My Aswer Is This]

alan:

I looked at helping with this question but was not able to do this part of the users request:

I would like to add row if in column F will be (Pres) ​

and in add row will be copy previous row.

​

Sounds like he wants inserted row to be a copy of previous row. The one with Pres in column F
​

​

 

[alansidman]

@Answer. Thanks for pointing that out. I missed it the first time around. Here is some modified code

Option Explicit


Sub mrmaso()
    Dim lr As Long, i As Long
    lr = Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = lr To 1 Step -1
        If Range("F" & i) = "Pres" Then
            Range("F" & i + 1).EntireRow.Insert
            Range("A" & i & ":G" & i).Copy
            Range("A" & i + 1).PasteSpecial xlPasteValues
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "Completed"
End Sub

 

[My Aswer Is This]

alan:
Yours works now.

Here is how I was going to do mine.
I forgot about running script backwards when inserting row.

Option Explicit

Sub Mine()
    Dim lr As Long, i As Long
    lr = Range("F" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = lr To 1 Step -1
        If Cells(i, "F") = "Pres" Then
            Rows(i).Offset(1).Insert
            Rows(i).Copy Rows(i + 1)
            
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "Completed"
End Sub