Automatically Insert Row

[marreco]

Hi.
But is this spreadsheet I'm trying to be automatically added rows.

Eg

In part that has "Locação de Equipamentos" ... when I, after filling out all the lines and need to add the item 6, I would like some command line that is automatically created and that all formulas of the previous line is it also .

Same thing on the part of "Cessão de mão de obra"

Thank you folks.

[LalitPandey87]

Hi marreco,

Could you please explain it more.

[Rajan_Verma]

would be better if you can make it more clear

[Excel Fox]

I would suggest you use a data table to do this.

[marreco]

Hi.
imagine that I have a new item that will be inserted into the "LOCAÇÃO DO EQUIPAMENTO"
Then in line 7 will always be shifted down so that the new item (5) is put.

[LalitPandey87]

Step 1:- Create Name Range for Cell B8 and named it 'rngSubTotalPart1'
Step 2:- Create Name Range for Cell B15 and named it 'rngSubTotalPart2'
Step 3:- Press Alt + F11 -> Alt + I + M and Paste below code in the module




Const strPart1RangeName As String = "rngSubTotalPart1"
Const strPart2RangeName As String = "rngSubTotalPart2"

Sub InsertRowFor_LOCACAO_DO_EQUIPAMENTO()

InsertRow strPart1RangeName

End Sub

Sub InsertRowFor_CESSAO_DE_MAODE_OBRA()

InsertRow strPart2RangeName

End Sub

Sub InsertRow(ByVal strSubTotalRange As String)

Dim wksSht As Worksheet

If Application.ScreenUpdating Then Application.ScreenUpdating = False

Set wksSht = ThisWorkbook.Worksheets("Plan1")

With wksSht
With .Range(strSubTotalRange).Offset(-1)
If .Value = "" Then
MsgBox "Row Already inserted. May be it is not filled.", vbInformation, "Row insert..."
GoTo ErlyExit
End If
.EntireRow.Copy
.EntireRow.Insert Shift:=xlDown
Application.CutCopyMode = False
If strSubTotalRange = strPart1RangeName Then
.Resize(, 5).Value = ""
.Offset(, 7).Value = ""
.Offset(, 10).Resize(, 2).Clear
ElseIf strSubTotalRange = strPart2RangeName Then
.Resize(, 6).Value = ""
End If
End With
End With

ErlyExit:
If Not Application.ScreenUpdating Then Application.ScreenUpdating = True

End Sub




Step 4:- Close This Window (Alt + F4)
Step 5:- Insert a Shape and right click on it -> click on Assign Macro and assign InsertRowFor_LOCACAO_DO_EQUIPAMENTO macro from the macro list in the pop up window.
Step 6:- Insert another shape, right click on shape, click on assign macro and assign InsertRowFor_CESSAO_DE_MAODE_OBRA macro to this one.
Step 7:- Done

[marreco]

Hi.

after inserting a row, I can not insert any more line

Thank you!!

[LalitPandey87]

Replace the above code with this one





Const strPart1RangeName As String = "rngSubTotalPart1"
Const strPart2RangeName As String = "rngSubTotalPart2"

Sub InsertRowFor_LOCACAO_DO_EQUIPAMENTO()

InsertRow strPart1RangeName

End Sub

Sub InsertRowFor_CESSAO_DE_MAODE_OBRA()

InsertRow strPart2RangeName

End Sub

Sub InsertRow(ByVal strSubTotalRange As String)

Dim wksSht As Worksheet

If Application.ScreenUpdating Then Application.ScreenUpdating = False

Set wksSht = ThisWorkbook.Worksheets("Plan1")

With wksSht
With .Range(strSubTotalRange).Offset(-1)
.EntireRow.Copy
.EntireRow.Insert Shift:=xlDown
Application.CutCopyMode = False
If strSubTotalRange = strPart1RangeName Then
.Resize(, 5).Value = ""
.Offset(, 7).Value = ""
.Offset(, 10).Resize(, 2).Clear
ElseIf strSubTotalRange = strPart2RangeName Then
.Resize(, 6).Value = ""
End If
End With
End With

ErlyExit:
set wksSht = Nothing
If Not Application.ScreenUpdating Then Application.ScreenUpdating = True

End Sub