VBA loop through rows, select a couple of them & then delete them-CodePudding

I have a dataset, in which i want to delete every x row of it (x = userinput). If i delete the rows immediately, the endresult will be incorrect because the row order changes with every deletion. I wrote this code so far:

Sub Delete_Data()
    'Take userinput
    Dim userInput As Variant
    Dim i As Long
    Do While True
        userInput = InputBox("please enter a number between 2-100", _
        "Lets delete some data XD")
        If IsNumeric(userInput) And userInput >= 2 _
        And userInput <= 100 Then
            Exit Do
        End If
        If MsgBox("Invalid Input, please redo or cancel", _
        vbOKCancel, "Invalid input") = vbCancel Then Exit Do
    Loop
    
    'Delete Rows
    Worksheets("Sheet1").Activate
    For i = 2 To Rows.count Step userInput
        If Rows.Cells(i, 1).Value = "" Then
            Rows(ActiveCell.Row).EntireRow.Delete
            MsgBox "you have successfully deleted every " _
            & userInput & "th row!"
            Exit For
        Else
            Rows(i).EntireRow.Select
        End If
    Next i
     
End Sub

The problem is that, the previous selection of a row disappears as soon as a new row gets selected. I hope you guys can help me out.

CodePudding user response：

Using a union your code would look like this:

Sub Delete_Data()
    'Take userinput
    Dim userInput As Variant
    Dim i As Long
    Do While True
        userInput = InputBox("please enter a number between 2-100", _
        "Lets delete some data XD")
        If IsNumeric(userInput) And userInput >= 2 _
        And userInput <= 100 Then
            Exit Do
        End If
        If MsgBox("Invalid Input, please redo or cancel", _
        vbOKCancel, "Invalid input") = vbCancel Then Exit Do
    Loop
    
    'Delete Rows
    With Worksheets("Sheet1")
        Dim delrng As Range
        For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row Step userInput 'Change 2 to whatever column has the most data
            If .Cells(i, 1).Value = "" Then
                If delrng Is Nothing Then
                    Set delrng = .Cells(i, 1).EntireRow
                Else
                    Set delrng = Union(delrng, .Cells(i, 1).EntireRow)
                End If
            End If
        Next i
    End With
        delrng.Delete
        Select Case True
            Case Right(userInput, 1) = 1 And Not userInput = 11
                MsgBox "you have successfully deleted every " _
                    & userInput & "st row!"
            Case Right(userInput, 1) = 2 And Not userInput = 12
                MsgBox "you have successfully deleted every " _
                    & userInput & "nd row!"
            
            Case Right(userInput, 1) = 3 And Not userInput = 13
                MsgBox "you have successfully deleted every " _
                    & userInput & "rd row!"
            Case Else
                MsgBox "you have successfully deleted every " _
                    & userInput & "th row!"
        End Select
End Sub

I expanded your Msgbox to properly concatenate based on the number.

CodePudding user response：

Thanks for your inputs:

thats the final code

Option Explicit

Sub Delete_Data()
    'Take userinput
    Dim userInput As Variant
    Dim i As Long
    Do While True
        userInput = InputBox("please enter a number between 2-100", _
        "Lets delete some data XD")
        If IsNumeric(userInput) And userInput >= 2 _
        And userInput <= 100 Then
            Exit Do
        End If
        If MsgBox("Invalid Input, please redo or cancel", _
        vbOKCancel, "Invalid input") = vbCancel Then Exit Sub
    Loop
    
    'Activate rows "to be deleted"
    With Worksheets("Sheet1")
        Dim delRange As Range
        For i = 2 To .Cells(.Rows.count, 2).End(xlUp).Row Step userInput
            If .Cells(i, 1).Value = "" Then
                Exit For
            ElseIf delRange Is Nothing Then
                Set delRange = .Cells(i, 1).EntireRow
            Else
                Set delRange = Union(delRange, .Cells(i, 1).EntireRow)
            End If
        Next i
    End With
    
    'Mark rows "to be deleted"
    delRange.Interior.ColorIndex = 6
    
    'Ask for deltetion cofirmation
    Dim answer As Variant
    answer = MsgBox("Do you really want to delete the selected rows?", _
    vbQuestion   vbYesNo   vbDefaultButton2, "Confirm deletion")
    If answer = vbYes Then
        delRange.Delete
    Else
        delRange.Interior.ColorIndex = xlNone
        Exit Sub
    End If
    
    'Give feedback to user & look for correct english wording
    Select Case True
            Case Right(userInput, 1) = 1 And Not userInput = 11
                MsgBox "you have successfully deleted every " _
                    & userInput & "st row!"
            Case Right(userInput, 1) = 2 And Not userInput = 12
                MsgBox "you have successfully deleted every " _
                    & userInput & "nd row!"
            
            Case Right(userInput, 1) = 3 And Not userInput = 13
                MsgBox "you have successfully deleted every " _
                    & userInput & "rd row!"
            Case Else
                MsgBox "you have successfully deleted every " _
                    & userInput & "th row!"
        End Select
End Sub