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