Hello,
I'm pleading for help and any help would be greatly appreciated. I'm searching for answer to my problem for over a week
. This is the last hope. Here is assingment I've got:
I'm trying to create funcy expense report where button exist to insert rows. I know how to assign macros to button but need macro code. I need to be able to click on button and see message that's asking user # of rows to insert. The tricky part is where I need rows to be inserted.
Here is example:
A1 - Travel Expenses
A2 - auto rental
A3 - meals
A4 - taxi
A5 - gas
A6 - Auto Expenses
I have data validation (from A2:A5) and need that rows to be copied before Auto Expeses and inserted cleared off from filled data (in this example w/o word "Gas") before Auto Expenses. As AutoExpenses shift down I would want macro to insert copied cells always above Auto Expenses cell.
I was able to find macro that inserts blank rows where active cell is located, but I'm still dummy in figuring out the code and modifying it to suite my need. Here is what i've got:
Sub sbInsertMultipleRows()
' Insert multiple rows at once. Rows are inserted above the' currently selected row/cell
Dim lNewRows As Long
Dim lCurrentRow As Long
' Let user choose an amount of rows to insert:
lNewRows = Application.InputBox("Number of rows to insert", _
"Insert multiple rows", 1, , , , , 1)
' Cancel if amount is 0 or user choose to cancel:
If lNewRows <= 0 Then Exit Sub
' Insert the rows: Rows(Selection.Cells(1).Row & ":" & _
Selection.Cells(1).Row + lNewRows - 1).Insert shift:=xlDown
'>>>>> change
ActiveCell.Resize(lNewRows, 1).EntireRow.Insert
ActiveCell.Offset(0, 0).Value = ""
On Error Resume Next
'>>>>> change
For i = 1 To lNewRows
For Each f In ActiveCell.Offset(-1, 0).EntireRow.SpecialCells(xlCellTypeFormulas)
f.Copy f.Offset(i, 0)
Next
Next i
On Error GoTo 0
End Sub
Your help is greatly appreciated!
Thank you in advance
Bookmarks