+ Reply to Thread
Results 1 to 1 of 1

Create macro to insert rows relative to the value

Hybrid View

ofranco Create macro to insert rows... 04-03-2012, 04:19 PM
  1. #1
    Registered User
    Join Date
    04-03-2012
    Location
    US
    MS-Off Ver
    Excel 2007
    Posts
    1

    Create macro to insert rows relative to the value

    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
    Last edited by Paul; 04-03-2012 at 05:00 PM. Reason: Added CODE tags for new user. Please do so yourself in the future.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1