+ Reply to Thread
Results 1 to 28 of 28

Add new rows + number of rows through dialogue box

Hybrid View

  1. #1
    Forum Contributor
    Join Date
    11-23-2015
    Location
    Yada, Wales
    MS-Off Ver
    Office 2013
    Posts
    176

    Add new rows + number of rows through dialogue box

    The code below is assigned to a button.
    When button is pressed, a dialogue box asks me to put marker where new rows (copy of first hidden row) shall be inserted.
    However, the rows are inserted where my selection is before I pressed the button, independent of where I tell my dialogue box where it should insert new rows.

    How can I tell the dialogue box where I want new rows?
    And is it possible to let it ask me also how many rows? (as of now, I have to insert a value at cell N2)

    Sub anr()
    ActiveSheet.Unprotect Password:="password"
    On Error Resume Next
    Set Ret = Application.InputBox("Put marker where new row is", "Add rows", Type:=8)
        On Error GoTo 0
        With ActiveCell.Resize([N2]).EntireRow
            .Insert
            .Offset(-[N2]).Value = Rows(1).FormulaR1C1
        End With
    ActiveSheet.Protect Password:="password"
    End Sub
    Last edited by jokris; 03-21-2016 at 04:53 PM.

  2. #2
    Valued Forum Contributor
    Join Date
    01-03-2016
    Location
    Conwy, Wales
    MS-Off Ver
    2016
    Posts
    974

    Re: Add new rows + number of rows through dialogue box

    Try this.
    To select the cell where row(s) to be inserted either enter the cell ref or select with pointer

    Sub InsertRows()
    ActiveSheet.Unprotect Password:="password"
    On Error Resume Next
        Dim rng As Range, NoOfRows As Integer
        Set rng = Application.InputBox("Select a cell to insert rows" & vbNewLine & "either input cell ref or select with pointer", "Where to insert rows", Type:=8)
    err.clear
        NoOfRows = CInt(InputBox("How many rows?", "Number of rows", 1))
        rng.EntireRow.Resize(NoOfRows).Insert
    End Sub

  3. #3
    Forum Contributor
    Join Date
    11-23-2015
    Location
    Yada, Wales
    MS-Off Ver
    Office 2013
    Posts
    176

    Re: Add new rows + number of rows through dialogue box

    I tried and the dialogue box works!
    However, it inserts blank rows. Is it possible to insert rows that are copies of my first hidden row? (as in my code above)

    Quote Originally Posted by Kevin# View Post
    Try this.
    To select the cell where row(s) to be inserted either enter the cell ref or select with pointer

    Sub InsertRows()
    ActiveSheet.Unprotect Password:="password"
    On Error Resume Next
        Dim rng As Range, NoOfRows As Integer
        Set rng = Application.InputBox("Select a cell to insert rows" & vbNewLine & "either input cell ref or select with pointer", "Where to insert rows", Type:=8)
    err.clear
        NoOfRows = CInt(InputBox("How many rows?", "Number of rows", 1))
        rng.EntireRow.Resize(NoOfRows).Insert
    End Sub

  4. #4
    Forum Expert Greg M's Avatar
    Join Date
    08-16-2007
    Location
    Dublin. Ireland
    MS-Off Ver
    Office 2016
    Posts
    4,481

    Re: Add new rows + number of rows through dialogue box

    Hi again,

    Thanks for your feedback and the Reputation increase on your previous post - much appreciated

    See if the following code does what you need for this:

    
    
    Option Explicit
    
    
    Sub AddRows()
    
        Const iINPUT_TYPE_RANGE As Integer = 8
        Const iHIDDEN_ROW_NO    As Integer = 1
        Const sNEW_ROWS_CELL    As String = "N2"
        Const sPASSWORD         As String = "password"
    
        Dim iNoOfnewRows        As Integer
        Dim rNewRowCell         As Range
        Dim wks                 As Worksheet
    
        Set wks = ActiveSheet
    
        Set rNewRowCell = Application.InputBox(Prompt:="Put marker where new row is", _
                                               Title:="Add rows", Type:=iINPUT_TYPE_RANGE)
    
        If Not rNewRowCell Is Nothing Then
    
            wks.Unprotect Password:=sPASSWORD
    
                iNoOfnewRows = wks.Range(sNEW_ROWS_CELL).Value
    
                With rNewRowCell.Resize(RowSize:=iNoOfnewRows).EntireRow
                    .Insert
                    .Offset(-iNoOfnewRows, 0).Value = wks.Rows(iHIDDEN_ROW_NO).FormulaR1C1
                End With
    
            wks.Protect Password:=sPASSWORD
    
        End If
    
    End Sub
    The highlighted values may be changed to suit your own requirements.


    Hope this helps - please let me know how you get on.

    Regards,

    Greg M
    Last edited by Greg M; 03-15-2016 at 05:54 PM. Reason: Minor improvement to code

  5. #5
    Forum Contributor
    Join Date
    11-23-2015
    Location
    Yada, Wales
    MS-Off Ver
    Office 2013
    Posts
    176

    Re: Add new rows + number of rows through dialogue box

    Thank you so much Greg for taking your time.

    The code works! But is it possible to avoid using cell N2 and instead having one more dialogue box directly after the first one, asking me how many rows I would like to insert?
    Last edited by jokris; 03-15-2016 at 06:06 PM.

  6. #6
    Forum Expert Greg M's Avatar
    Join Date
    08-16-2007
    Location
    Dublin. Ireland
    MS-Off Ver
    Office 2016
    Posts
    4,481

    Re: Add new rows + number of rows through dialogue box

    Hi again,


    And is it possible to let it ask me also how many rows? (as of now, I have to insert a value at cell N2)

    See if the following code does what you need:

    
    
    Option Explicit
    
    
    Sub AddRows()
    
        Const iINPUT_TYPE_RANGE As Integer = 8
        Const iINPUT_TYPE_NO    As Integer = 1
        Const iHIDDEN_ROW_NO    As Integer = 1
        Const sPASSWORD         As String = "password"
    
        Dim iNoOfnewRows        As Integer
        Dim rNewRowCell         As Range
        Dim wks                 As Worksheet
    
        Set wks = ActiveSheet
    
        iNoOfnewRows = Application.InputBox(Prompt:="How many new rows should be added?", _
                                            Title:="Add rows", Type:=iINPUT_TYPE_NO)
    
        If iNoOfnewRows > 0 Then
    
            Set rNewRowCell = Application.InputBox(Prompt:="Put marker where new row is", _
                                                   Title:="Add rows", Type:=iINPUT_TYPE_RANGE)
    
            If Not rNewRowCell Is Nothing Then
    
                wks.Unprotect Password:=sPASSWORD
    
                    With rNewRowCell.Resize(RowSize:=iNoOfnewRows).EntireRow
                        .Insert
                        .Offset(-iNoOfnewRows, 0).Value = wks.Rows(iHIDDEN_ROW_NO).FormulaR1C1
                    End With
    
                wks.Protect Password:=sPASSWORD
    
            End If
    
        End If
    
    End Sub
    The highlighted values may be changed to suit your own requirements.


    Hope this helps - as before, please let me know how you get on.

    Regards,

    Greg M

  7. #7
    Forum Contributor
    Join Date
    11-23-2015
    Location
    Yada, Wales
    MS-Off Ver
    Office 2013
    Posts
    176

    Re: Add new rows + number of rows through dialogue box

    Greg, it works great now!
    Have to test everything more tomorrow, but right now it is doing just what I wanted to.
    Thank you so much

    (trying to give you more reputation points but am told to spread them out more)
    Last edited by jokris; 03-15-2016 at 06:35 PM.

  8. #8
    Forum Expert Greg M's Avatar
    Join Date
    08-16-2007
    Location
    Dublin. Ireland
    MS-Off Ver
    Office 2016
    Posts
    4,481

    Re: Add new rows + number of rows through dialogue box

    Hi again,

    Many thanks for your latest feedback and also for trying to give me even more Reputation points - very much appreciated

    You're very welcome - I'm pleased that I was able to help out.

    Please feel free to ask if there's any further information you need.

    Best regards,

    Greg M

  9. #9
    Valued Forum Contributor
    Join Date
    01-03-2016
    Location
    Conwy, Wales
    MS-Off Ver
    2016
    Posts
    974

    Re: Add new rows + number of rows through dialogue box

    And this is earlier code amended to include the copying of row1

    Sub InsertRows()
    ActiveSheet.Unprotect Password:="password"
    On Error Resume Next
        Dim rng As Range, NoOfRows As Integer
        Set rng = Application.InputBox("Select a cell to insert rows" & vbNewLine & "either input cell ref or select with pointer", "Where to insert rows", Type:=8)
    err.clear
        NoOfRows = CInt(InputBox("How many rows?", "Number of rows", 1))
        Rows(1).Copy
        rng.EntireRow.Resize(NoOfRows).Insert
    
    End Sub

  10. #10
    Forum Contributor
    Join Date
    11-23-2015
    Location
    Yada, Wales
    MS-Off Ver
    Office 2013
    Posts
    176

    Re: Add new rows + number of rows through dialogue box

    If I perform this procedure on "worksheet A" with its hidden first row, would it be possible to automatically make the same thing happen on "worksheet B" and "worksheet C" (but not "worksheet D" ?
    Each of Worksheet B and C have a unique hidden row at the top too.

    So for chosen worksheets, I would like the same procedure to happen automatically when I do this on "worksheet A"
    Last edited by jokris; 03-16-2016 at 04:00 AM.

  11. #11
    Valued Forum Contributor
    Join Date
    01-03-2016
    Location
    Conwy, Wales
    MS-Off Ver
    2016
    Posts
    974

    Re: Add new rows + number of rows through dialogue box

    Note that
    rng is now Dim as string
    and that next line down has .address at the end
    and that rng has become Range(rng) in the other lines

    Sub InsertRows()
    ActiveSheet.Unprotect Password:="password"
        Dim rng As String, NoOfRows As Integer
        rng = Application.InputBox("Select a cell to insert rows" & vbNewLine & "either input cell ref or select with pointer", "Where to insert rows", Type:=8).Address
        
        NoOfRows = CInt(InputBox("How many rows?", "Number of rows", 1))
        
        Rows(1).Copy
        Range(rng).EntireRow.Resize(NoOfRows).Insert
        
        Sheets("SheetB").Rows(1).Copy
        Sheets("SheetB").Range(rng).EntireRow.Resize(NoOfRows).Insert
        Sheets("SheetC").Rows(1).Copy
        Sheets("SheetC").Range(rng).EntireRow.Resize(NoOfRows).Insert
        
        
        
        Err.Clear
    End Sub
    Last edited by Kevin#; 03-16-2016 at 07:33 AM.

  12. #12
    Forum Expert Greg M's Avatar
    Join Date
    08-16-2007
    Location
    Dublin. Ireland
    MS-Off Ver
    Office 2016
    Posts
    4,481

    Re: Add new rows + number of rows through dialogue box

    Hi again,

    Try the following code and see if it does what you need. It incorporates data validation for both of the User input values (number of new rows and location of new rows):

    
    
    Option Explicit
    
    
    Sub AddRows()
    
        Const iINPUT_TYPE_RANGE As Integer = 8
        Const iINPUT_TYPE_NO    As Integer = 1
        Const iHIDDEN_ROW_NO    As Integer = 1
        Const sSHEET_NAME_1     As String = "Worksheet A"
        Const sSHEET_NAME_2     As String = "Worksheet B"
        Const sSHEET_NAME_3     As String = "Worksheet C"
        Const sPASSWORD         As String = "password"
    
        Dim iNoOfNewRows        As Integer
        Dim rNewRowCell         As Range
        Dim vSheetName          As Variant
        Dim iNewRowNo           As Integer
        Dim wks                 As Worksheet
    
        iNoOfNewRows = Application.InputBox(Prompt:="How many new rows should be added?", _
                                            Title:="Add rows", Type:=iINPUT_TYPE_NO)
    
        If iNoOfNewRows > 0 Then
    
            Set rNewRowCell = Application.InputBox(Prompt:="Put marker where new row is", _
                                                   Title:="Add rows", Type:=iINPUT_TYPE_RANGE)
    
            If Not rNewRowCell Is Nothing Then
    
                If rNewRowCell.Cells.Count = 1 Then
    
                      iNewRowNo = rNewRowCell.Row
    
                      For Each vSheetName In Array(sSHEET_NAME_1, sSHEET_NAME_2, sSHEET_NAME_3)
    
                          Set wks = ThisWorkbook.Worksheets(CStr(vSheetName))
    
                          wks.Unprotect Password:=sPASSWORD
    
                              With wks.Rows(iNewRowNo).Resize(RowSize:=iNoOfNewRows)
                                  .Insert
                                  .Offset(-iNoOfNewRows, 0).Value = wks.Rows(iHIDDEN_ROW_NO).FormulaR1C1
                              End With
    
                          wks.Protect Password:=sPASSWORD
    
                      Next vSheetName
    
                Else: MsgBox "Only a single cell may be selected", vbExclamation
    
                End If          '       If rNewRowCell.Cells.Count = 1
    
            End If              '       If Not rNewRowCell Is Nothing
    
        End If                  '       If iNoOfNewRows > 0
    
    End Sub
    The highlighted values may be changed to suit your own requirements.

    The routine will work regardless of what worksheet is active when the routine is called.


    Hope this helps - as before, please let me know how you get on.

    Regards,

    Greg M

  13. #13
    Forum Contributor
    Join Date
    11-23-2015
    Location
    Yada, Wales
    MS-Off Ver
    Office 2013
    Posts
    176

    Re: Add new rows + number of rows through dialogue box

    I tried both your codes and they work excellent!

    Only have one concern left now as it seems.
    When people add or delete rows, I don't want them to do it on the first say 5 rows, which has information that needs a fixed position.

    So I would only like them to add or delete beginning with the 6th row. So trying to insert or delete something within the five first rows should result in an error message of some kind.

  14. #14
    Forum Expert Greg M's Avatar
    Join Date
    08-16-2007
    Location
    Dublin. Ireland
    MS-Off Ver
    Office 2016
    Posts
    4,481

    Re: Add new rows + number of rows through dialogue box

    Hi again,

    Many thanks for your feedback.

    See if the following code does what you need - data validation has been incorporated into two separate function routines to make the main routine a little easier to follow

    
    
    Option Explicit
    
    
    '==========================================================================================
    '==========================================================================================
    
    Sub AddRows()
    
        Const iHIDDEN_ROW_NO    As Integer = 1
        Const sSHEET_NAME_1     As String = "Worksheet A"
        Const sSHEET_NAME_2     As String = "Worksheet B"
        Const sSHEET_NAME_3     As String = "Worksheet C"
        Const sPASSWORD         As String = "password"
    
        Dim iNoOfNewRows        As Integer
        Dim vSheetName          As Variant
        Dim iNewRowNo           As Integer
        Dim wks                 As Worksheet
    
        iNoOfNewRows = miNoOfNewRows()
    
        If iNoOfNewRows > 0 Then
    
            iNewRowNo = miNewRowNo()
    
            If iNewRowNo > 0 Then
    
                For Each vSheetName In Array(sSHEET_NAME_1, sSHEET_NAME_2, sSHEET_NAME_3)
    
                    Set wks = ThisWorkbook.Worksheets(CStr(vSheetName))
    
                    wks.Unprotect Password:=sPASSWORD
    
                        With wks.Rows(iNewRowNo).Resize(RowSize:=iNoOfNewRows)
                            .Insert
                            .Offset(-iNoOfNewRows, 0).Value = wks.Rows(iHIDDEN_ROW_NO).FormulaR1C1
                        End With
    
                    wks.Protect Password:=sPASSWORD
    
                Next vSheetName
    
            End If
    
        End If
    
    End Sub
    
    
    '==========================================================================================
    '==========================================================================================
    
    
    Private Function miNoOfNewRows() As Integer
    
        Const iMAX_NO_OF_NEW_ROWS   As Integer = 9
        Const iINPUT_TYPE_NO        As Integer = 1
    
        Dim iNoOfNewRows            As Integer
    
        iNoOfNewRows = 0
    
        iNoOfNewRows = Application.InputBox(Prompt:="How many new rows should be added?", _
                                            Title:="Add rows", Type:=iINPUT_TYPE_NO)
    
        If iNoOfNewRows > 0 Then
    
            If iNoOfNewRows <= iMAX_NO_OF_NEW_ROWS Then
    
                  miNoOfNewRows = iNoOfNewRows
    
            Else: MsgBox "A maximum of " & iMAX_NO_OF_NEW_ROWS & " new rows may be added", _
                          vbExclamation
    
                  miNoOfNewRows = 0
    
            End If
    
        End If
    
    End Function
    
    
    '==========================================================================================
    '==========================================================================================
    
    
    Private Function miNewRowNo() As Integer
    
        Const iMINIMUM_NEW_ROW_NO   As Integer = 6
        Const iINPUT_TYPE_RANGE     As Integer = 8
    
        Dim rNewRowCell             As Range
        Dim iNewRowNo               As Integer
    
        iNewRowNo = 0
    
        Set rNewRowCell = Application.InputBox(Prompt:="Put marker where new row is", _
                                               Title:="Add rows", Type:=iINPUT_TYPE_RANGE)
    
        If Not rNewRowCell Is Nothing Then
    
            If rNewRowCell.Cells.Count = 1 Then
    
                  If rNewRowCell.Row >= iMINIMUM_NEW_ROW_NO Then
    
                      miNewRowNo = rNewRowCell.Row
    
                  Else: MsgBox "New rows must be inserted from Row " & _
                               iMINIMUM_NEW_ROW_NO & " onwards", vbExclamation
    
                  End If
    
            Else: MsgBox "Only a single cell may be selected", vbExclamation
    
            End If
    
        End If
    
    End Function
    As before, the highlighted values may be changed to suit your requirements.

    Hope this helps - as always, please let me know how you get on.

    Regards,

    Greg M



    P. S. Many thanks also for the Reputation increase - much appreciated
    Last edited by Greg M; 03-16-2016 at 10:12 AM. Reason: P. S. added

  15. #15
    Valued Forum Contributor
    Join Date
    01-03-2016
    Location
    Conwy, Wales
    MS-Off Ver
    2016
    Posts
    974

    Re: Add new rows + number of rows through dialogue box

    Sub InsertRows()
    ActiveSheet.Unprotect Password:="password"
        Dim rng As String, NoOfRows As Integer
    TryAgain:
        rng = Application.InputBox("Select a cell to insert rows  (row 6 onwards)" & vbNewLine & "either input cell ref or select with pointer", "Where to insert rows", Type:=8).Address
            If Range(rng).Row < 6 Then
                MsgBox "Can't you read?" & vbNewLine & "Row " & Range(rng).Row & " is before row 6"
                GoTo TryAgain:
            End If
        NoOfRows = CInt(InputBox("How many rows?", "Number of rows", 1))
        
        Rows(1).Copy
        Range(rng).EntireRow.Resize(NoOfRows).Insert
        
        Sheets("SheetB").Rows(1).Copy
        Sheets("SheetB").Range(rng).EntireRow.Resize(NoOfRows).Insert
        Sheets("SheetC").Rows(1).Copy
        Sheets("SheetC").Range(rng).EntireRow.Resize(NoOfRows).Insert
        
        
        
        Err.Clear
    End Sub
    Given that you now have 2 solutions can you please mark the thread as doubly solved
    thanks

  16. #16
    Forum Contributor
    Join Date
    11-23-2015
    Location
    Yada, Wales
    MS-Off Ver
    Office 2013
    Posts
    176

    Re: Add new rows + number of rows through dialogue box

    Your codes work when adding new rows in several sheets too! Amazing knowledge...
    is it also possible to do the opposite? That is, deleting selected rows (starting from row 6) on one of the worksheets and thus deleting the same rows on the other worksheets?

    BTW, can I buy you guys a beer or something?
    Last edited by jokris; 03-17-2016 at 01:41 AM.

  17. #17
    Valued Forum Contributor
    Join Date
    01-03-2016
    Location
    Conwy, Wales
    MS-Off Ver
    2016
    Posts
    974

    Re: Add new rows + number of rows through dialogue box

    How about trying the obvious out for yourself and you providing the answer?
    There are 3 lines that are no longer required and 3 that need a very minor alteration

  18. #18
    Forum Contributor
    Join Date
    11-23-2015
    Location
    Yada, Wales
    MS-Off Ver
    Office 2013
    Posts
    176

    Re: Add new rows + number of rows through dialogue box

    I will try later on today to find a solution to this.
    Hopefully I can figure out how this will work and compare with deletion formula.

    I would love to learn VBA for myself and understand how it works.
    Otherwise I would gladly pay a symbolic sum if I can't come up with an answer.

  19. #19
    Valued Forum Contributor
    Join Date
    01-03-2016
    Location
    Conwy, Wales
    MS-Off Ver
    2016
    Posts
    974

    Re: Add new rows + number of rows through dialogue box

    hint:
    the antonym of "insert" is "delete"

  20. #20
    Forum Expert Greg M's Avatar
    Join Date
    08-16-2007
    Location
    Dublin. Ireland
    MS-Off Ver
    Office 2016
    Posts
    4,481

    Re: Add new rows + number of rows through dialogue box

    Hi again Johan,

    See if the following code does what you need - if you study it you can see how breaking it down into separate routines allows you avoid duplicating large amounts of code for the Add Rows and the Delete Rows processes:

    
    
    Option Explicit
    
    
    '==========================================================================================
    '==========================================================================================
    
    
    Const msOPERATION_DELETE    As String = "Delete Rows"
    Const msOPERATION_ADD       As String = "Add Rows"
    
    
    '==========================================================================================
    '==========================================================================================
    
    
    Sub AddRows()
    
        Call AddOrDeleteRows(sOperationType:=msOPERATION_ADD)
    
    End Sub
    
    
    '==========================================================================================
    '==========================================================================================
    
    
    Sub DeleteRows()
    
        Call AddOrDeleteRows(sOperationType:=msOPERATION_DELETE)
    
    End Sub
    
    
    '==========================================================================================
    '==========================================================================================
    
    
    Private Sub AddOrDeleteRows(sOperationType As String)
    
        Const iHIDDEN_ROW_NO    As Integer = 1
        Const sPASSWORD         As String = "password"
    
        Dim iNoOfRowsInvolved   As Integer
        Dim vaWorksheets        As Variant
        Dim iStartRowNo         As Integer
        Dim vWorksheet          As Variant
    
        iNoOfRowsInvolved = miNoOfRowsInvolved(sOperationType:=sOperationType)
    
        If iNoOfRowsInvolved > 0 Then
    
            iStartRowNo = miStartRowNo(sOperationType:=sOperationType)
    
            If iStartRowNo > 0 Then
    
                vaWorksheets = mvaWorksheets()
    
                For Each vWorksheet In vaWorksheets
    
                    With vWorksheet
    
                        .Unprotect Password:=sPASSWORD
    
                            With .Rows(iStartRowNo).Resize(RowSize:=iNoOfRowsInvolved)
    
                                If sOperationType = msOPERATION_ADD Then
    
                                        .Insert
                                        .Offset(-iNoOfRowsInvolved, 0).Formula = vWorksheet.Rows(iHIDDEN_ROW_NO).Formula
    
                                ElseIf sOperationType = msOPERATION_DELETE Then
    
                                        .Delete
    
                                End If
    
                            End With
    
                        .Protect Password:=sPASSWORD
    
                    End With
    
                Next vWorksheet
    
            End If
    
        End If
    
    End Sub
    
    
    '==========================================================================================
    '==========================================================================================
    
    
    Private Function mvaWorksheets() As Variant
    
        Const sSHEET_NAME_1 As String = "Worksheet A"
        Const sSHEET_NAME_2 As String = "Worksheet B"
        Const sSHEET_NAME_3 As String = "Worksheet C"
    
        With ThisWorkbook
    
            mvaWorksheets = Array(.Worksheets(sSHEET_NAME_1), .Worksheets(sSHEET_NAME_2), _
                                  .Worksheets(sSHEET_NAME_3))
    
        End With
    
    End Function
    
    
    '==========================================================================================
    '==========================================================================================
    
    
    Private Function miNoOfRowsInvolved(sOperationType As String) As Integer
    
        Const iMAX_NO_OF_ROWS       As Integer = 9
        Const iINPUT_TYPE_NO        As Integer = 1
    
        Dim iNoOfRowsInvolved       As Integer
        Dim sPrompt                 As String
    
        iNoOfRowsInvolved = 0
    
        sPrompt = "How many rows are involved in the " & sOperationType & " operation?"
    
        iNoOfRowsInvolved = Application.InputBox(Prompt:=sPrompt, Title:=sOperationType, _
                                                 Type:=iINPUT_TYPE_NO)
    
        If iNoOfRowsInvolved > 0 Then
    
            If iNoOfRowsInvolved <= iMAX_NO_OF_ROWS Then
    
                  miNoOfRowsInvolved = iNoOfRowsInvolved
    
            Else: MsgBox "A maximum of " & iMAX_NO_OF_ROWS & " new rows may be added", _
                          vbExclamation
    
                  miNoOfRowsInvolved = 0
    
            End If
    
        End If
    
    End Function
    
    
    '==========================================================================================
    '==========================================================================================
    
    
    Private Function miStartRowNo(sOperationType As String) As Integer
    
        Const iMINIMUM_START_ROW_NO As Integer = 6
        Const iINPUT_TYPE_RANGE     As Integer = 8
    
        Dim rStartRowCell           As Range
        Dim iStartRowNo             As Integer
        Dim sPrompt                 As String
    
        iStartRowNo = 0
    
        sPrompt = "Select the cell at which the " & sOperationType & " operation should start"
    
        On Error Resume Next
            Set rStartRowCell = Nothing
            Set rStartRowCell = Application.InputBox(Prompt:=sPrompt, Title:=sOperationType, _
                                                     Type:=iINPUT_TYPE_RANGE)
        On Error GoTo 0
    
        If Not rStartRowCell Is Nothing Then
    
            If rStartRowCell.Cells.Count = 1 Then
    
                  If rStartRowCell.Row >= iMINIMUM_START_ROW_NO Then
    
                      miStartRowNo = rStartRowCell.Row
    
                  Else: MsgBox "The start row may not be above Row " & iMINIMUM_START_ROW_NO, _
                                vbExclamation
    
                  End If
    
            Else: MsgBox "Only a single cell may be selected", vbExclamation
    
            End If
    
        End If
    
    End Function
    As before, the highlighted values may be changed to suit your own requirements.


    Feel free to ask if you require further information about anything.

    Hope this helps - as always, please let me know how you get on.

    If you really feel the need to "buy me a beer" I'd be very pleased if you'd make an equivalent donation to The Dogs Trust

    Best regards,

    Greg M

  21. #21
    Forum Contributor
    Join Date
    11-23-2015
    Location
    Yada, Wales
    MS-Off Ver
    Office 2013
    Posts
    176

    Re: Add new rows + number of rows through dialogue box

    The Dogs Trust at https://www.dogstrust.org.uk/ I guess? Will do

    I am looking more for something similar to this style below that I already use (but code below only works for the current worksheet, not multiple worksheets A, B and C. And problem is the code can erase row 1-5 which I want to stay intact). The code first asks me to mark the rows I want to delete, before I delete them. I think that is good because it makes it possible to mark say row 6 and row 9 (but not row 7 and 8).

    Option Explicit
    
    Sub DeleteMe()
        Dim Ret As Range, Cl As Range
        On Error Resume Next
        Set Ret = Application.InputBox("Mark rows to delete", "Delete rows", Type:=8)
        On Error GoTo 0
        ActiveSheet.Unprotect Password:="password"
        If Not Ret Is Nothing Then Ret.EntireRow.Delete
        ActiveSheet.Protect Password:="password"
    End Sub
    Last edited by jokris; 03-17-2016 at 09:29 AM.

  22. #22
    Forum Expert Greg M's Avatar
    Join Date
    08-16-2007
    Location
    Dublin. Ireland
    MS-Off Ver
    Office 2016
    Posts
    4,481

    Re: Add new rows + number of rows through dialogue box

    Hi again,

    Thanks for noting The Dogs Trust

    As you want to use different approaches for specifying the parameters in the Add Rows and Delete Rows operations, we can't use as much "common code" as before.

    The following code allows you to specify non-touching rows for deletion, and displays a message asking you to confirm the delete operation:

    
    
    Option Explicit
    
    
    '==========================================================================================
    '==========================================================================================
    
    
    Const miMINIMUM_START_ROW_NO    As Integer = 6
    Const miMAX_NO_OF_ROWS          As Integer = 9
    Const msPASSWORD                As String = "password"
    
    
    '==========================================================================================
    '==========================================================================================
    
    
    Sub AddRows()
    
        Const iHIDDEN_ROW_NO    As Integer = 1
    
        Dim iNoOfRowsToAdd      As Integer
        Dim vaWorksheets        As Variant
        Dim iStartRowNo         As Integer
        Dim vWorksheet          As Variant
    
        iNoOfRowsToAdd = miNoOfRowsToAdd()
    
        If iNoOfRowsToAdd > 0 Then
    
            iStartRowNo = miStartRowNo()
    
            If iStartRowNo > 0 Then
    
                vaWorksheets = mvaWorksheets()
    
                For Each vWorksheet In vaWorksheets
    
                    With vWorksheet
    
                        .Unprotect Password:=msPASSWORD
    
                            With .Rows(iStartRowNo).Resize(RowSize:=iNoOfRowsToAdd)
                                .Insert
                                .Offset(-iNoOfRowsToAdd, 0).Formula = vWorksheet.Rows(iHIDDEN_ROW_NO).Formula
                            End With
    
                        .Protect Password:=msPASSWORD
    
                    End With
    
                Next vWorksheet
    
            End If
    
        End If
    
    End Sub
    
    
    '==========================================================================================
    '==========================================================================================
    
    
    Sub DeleteRows()
    
        Dim sRowsToDelete   As String
        Dim vaWorksheets    As Variant
        Dim vWorksheet      As Variant
    
        sRowsToDelete = msRowsToDelete()
    
        If sRowsToDelete <> vbNullString Then
    
            vaWorksheets = mvaWorksheets()
    
            For Each vWorksheet In vaWorksheets
    
                With vWorksheet
    
                    .Unprotect Password:=msPASSWORD
    
                        vWorksheet.Range(sRowsToDelete).Delete
    
                    .Protect Password:=msPASSWORD
    
                End With
    
            Next vWorksheet
    
        End If
    
    End Sub
    
    
    '==========================================================================================
    '==========================================================================================
    
    
    Private Function mvaWorksheets() As Variant
    
        Const sSHEET_NAME_1 As String = "Worksheet A"
        Const sSHEET_NAME_2 As String = "Worksheet B"
        Const sSHEET_NAME_3 As String = "Worksheet C"
    
        With ThisWorkbook
    
            mvaWorksheets = Array(.Worksheets(sSHEET_NAME_1), .Worksheets(sSHEET_NAME_2), _
                                  .Worksheets(sSHEET_NAME_3))
    
        End With
    
    End Function
    
    
    '==========================================================================================
    '==========================================================================================
    
    
    Private Function miNoOfRowsToAdd() As Integer
    
        Const iINPUT_TYPE_NO    As Integer = 1
    
        Dim iNoOfRowsToAdd      As Integer
    
        iNoOfRowsToAdd = 0
    
        iNoOfRowsToAdd = Application.InputBox(Prompt:="How many rows should be added?", _
                                              Title:="Add Rows", _
                                              Type:=iINPUT_TYPE_NO)
    
        If iNoOfRowsToAdd > 0 Then
    
            If iNoOfRowsToAdd <= miMAX_NO_OF_ROWS Then
    
                  miNoOfRowsToAdd = iNoOfRowsToAdd
    
            Else: MsgBox "A maximum of " & miMAX_NO_OF_ROWS & " new rows may be added", _
                          vbExclamation
    
                  miNoOfRowsToAdd = 0
    
            End If
    
        End If
    
    End Function
    
    
    '==========================================================================================
    '==========================================================================================
    
    
    Private Function miStartRowNo() As Integer
    
        Const iINPUT_TYPE_RANGE As Integer = 8
    
        Dim rStartRowCell       As Range
        Dim iStartRowNo         As Integer
        Dim sPrompt             As String
    
        iStartRowNo = 0
    
        sPrompt = "Select the cell at which the Add Rows operation should start"
    
        On Error Resume Next
            Set rStartRowCell = Nothing
            Set rStartRowCell = Application.InputBox(Prompt:=sPrompt, Title:="Add Rows", _
                                                     Type:=iINPUT_TYPE_RANGE)
        On Error GoTo 0
    
        If Not rStartRowCell Is Nothing Then
    
            If rStartRowCell.Cells.Count = 1 Then
    
                  If rStartRowCell.Row >= miMINIMUM_START_ROW_NO Then
    
                      miStartRowNo = rStartRowCell.Row
    
                  Else: MsgBox "The start row may not be above Row " & miMINIMUM_START_ROW_NO, _
                                vbExclamation
    
                  End If
    
            Else: MsgBox "Only a single cell may be selected", vbExclamation
    
            End If
    
        End If
    
    End Function
    
    
    '==========================================================================================
    '==========================================================================================
    
    
    Private Function msRowsToDelete() As String
    
        Dim iNoOfRowsToDelete   As Integer
        Dim rRowsToDelete       As Range
        Dim sMessage            As String
        Dim iYesNo              As Integer
        Dim rRow                As Range
    
        Set rRowsToDelete = Selection
        iNoOfRowsToDelete = 0
    
        On Error Resume Next
            iNoOfRowsToDelete = rRowsToDelete.Rows.Count
        On Error GoTo 0
    
        If iNoOfRowsToDelete > 0 Then
    
            If iNoOfRowsToDelete <= miMAX_NO_OF_ROWS Then
    
                      For Each rRow In rRowsToDelete.Rows
    
                          If rRow.Row >= miMINIMUM_START_ROW_NO Then
    
                                sMessage = sMessage & vbLf & vbTab & rRow.Row
    
                          Else: MsgBox "Rows above Row " & miMINIMUM_START_ROW_NO & _
                                       " may not be selected for deletion", vbExclamation
    
                                Set rRowsToDelete = Nothing
                                Exit For
    
                          End If
    
                      Next rRow
    
                Else: MsgBox "A maximum of " & miMAX_NO_OF_ROWS & " rows may be deleted", _
                              vbExclamation
    
                      Set rRowsToDelete = Nothing
    
            End If
    
            If Not rRowsToDelete Is Nothing Then
    
                sMessage = "The following rows will be permanently deleted:" & _
                            vbLf & sMessage & vbLf & vbLf & _
                           "Do you wish to continue?"
    
                iYesNo = MsgBox(sMessage, vbYesNo + vbDefaultButton2)
    
                If iYesNo = vbYes Then
                      msRowsToDelete = rRowsToDelete.EntireRow.Address
                Else: msRowsToDelete = vbNullString
                End If
    
            End If
    
        End If
    
    End Function

    Hope this helps - as always, please keep me posted!

    Regards,

    Greg M

  23. #23
    Forum Expert Greg M's Avatar
    Join Date
    08-16-2007
    Location
    Dublin. Ireland
    MS-Off Ver
    Office 2016
    Posts
    4,481

    Re: Add new rows + number of rows through dialogue box

    Hi again Johan,

    Thanks for the Private Messages re the above.

    Further to your post http://www.excelforum.com/excel-prog...-password.html, see if the attached workbook does what you need. I can't access the Commercial Services forum to post my reply there.

    The code includes a "Confirm Deletion" message which isn't mentioned in your specification, but if you don't want to use it just change the value in:

    
    Const mbCONFIRM_BEFORE_DELETING As Boolean = True
    from True to False

    Hope this helps - as always, please let me know how you get on.

    Best regards,

    Greg M
    Attached Files Attached Files
    Last edited by Greg M; 03-21-2016 at 09:25 AM. Reason: Typo corrected

  24. #24
    Forum Contributor
    Join Date
    11-23-2015
    Location
    Yada, Wales
    MS-Off Ver
    Office 2013
    Posts
    176

    Re: Add new rows + number of rows through dialogue box

    The code works great, confuses me though why it won't work for my file.
    Sent you my file through private message and explanation of how interval of insertion and deletion of rows was implemented.
    The last possible place to insert rows is based on if the row doesn't contain anything. Then it makes it impossible to insert rows after this empty row (which means that there can't be an empty row above where you insert rows.

    I must say I am a little amazed over how fast your code is!

    I'll be away for some hours, but will be in touch again

  25. #25
    Forum Expert Greg M's Avatar
    Join Date
    08-16-2007
    Location
    Dublin. Ireland
    MS-Off Ver
    Office 2016
    Posts
    4,481

    Re: Add new rows + number of rows through dialogue box

    Hi Johan,

    Thanks for the Private Message and the workbook.

    As per your specification:


    5) If selected row is more than the row number that contains the word "maximum", a dialog box tells it is not possible to add copies here. Code ends.

    the word "Maximum" is inserted (once per column) in various cells in Column A of the worksheets in the version I posted here - this determines the point beyond which rows may not be added or deleted on that worksheet.

    For the workbook you sent me, when I inserted the word "Maximum" in Cell A19 of the worksheets Multiplesheet1, Multiplesheet2 and Multiplesheet3 (and "pointed" your buttons at my routines) everything seemed to work correctly.

    Please keep me informed and feel free to ask about anything that's not clear to you.

    Best regards,

    Greg M



    P. S. Your comments about the commercially-obtained software were interesting! I'd certainly be interested in seeing it if you'd care to send it to me.
    Last edited by Greg M; 03-21-2016 at 01:02 PM. Reason: P. S. added

  26. #26
    Forum Contributor
    Join Date
    11-23-2015
    Location
    Yada, Wales
    MS-Off Ver
    Office 2013
    Posts
    176

    Re: Add new rows + number of rows through dialogue box

    I sent you the file Greg and tried to explain what each of the six included codes in Module1 do (they should fill their purposes).
    Feel free to test it out.

    There is no "maximum" word as a placeholder in the end, but rather EndRow in MultipleSheets and empty row right after the last row with formulas and formatting as the last place to insert rows in SheetA, Figure and Object

    It bugs me somewhat that when performing the code it takes some time, especially compared to your code which seems much faster... and I have no idea why. Perhaps it is going through too much data or something?

  27. #27
    Forum Expert Greg M's Avatar
    Join Date
    08-16-2007
    Location
    Dublin. Ireland
    MS-Off Ver
    Office 2016
    Posts
    4,481

    Re: Add new rows + number of rows through dialogue box

    Hi Johan,

    I've made some changes to the file you sent me. I can post it here, but if you'd prefer that I didn't, send me your email address in a Private Message and I'll email it to you.

    Regards,

    Greg M

  28. #28
    Forum Expert Greg M's Avatar
    Join Date
    08-16-2007
    Location
    Dublin. Ireland
    MS-Off Ver
    Office 2016
    Posts
    4,481

    Re: Add new rows + number of rows through dialogue box

    Hi Johan,

    Thanks for your email and workbook.

    I'll post the latest version of my model workbook here in case anyone else has been following this thread.

    Regards,

    Greg M
    Attached Files Attached Files

+ Reply to Thread

Thread Information

Users Browsing this Thread

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

Similar Threads

  1. [SOLVED] Macro to insert specific number of rows, populate rows with data above except date
    By Melissa Camp in forum Excel Programming / VBA / Macros
    Replies: 11
    Last Post: 10-08-2015, 03:59 PM
  2. Replies: 1
    Last Post: 11-11-2013, 04:27 PM
  3. Dialogue box to search date range of table column, copy relevant rows to report sheet
    By Tim Newton in forum Excel Programming / VBA / Macros
    Replies: 18
    Last Post: 08-26-2013, 03:10 AM
  4. [SOLVED] Macro code to insert 3 rows on spreadsheet with variable number of rows
    By D18GE in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 06-17-2013, 07:33 AM
  5. [SOLVED] Need VBA code to count number of rows & split into group of 7 rows in same sheet
    By amy_d2 in forum Excel Programming / VBA / Macros
    Replies: 11
    Last Post: 06-05-2013, 11:03 AM
  6. [SOLVED] VBA insert/delete rows to accommodate exact number of rows from incoming data
    By iloc in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 11-12-2012, 06:19 PM
  7. [SOLVED] Insert Multiple Rows Based Off Number in Cell and Copy Data From Above New Rows
    By tstell1 in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 10-02-2012, 04:15 PM

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