VBA multiple selection

[JessWhyCuh]

Is there a way to allow multiple selection delete? Like the user selects more than 1 cell and pushes the delete button without causing an error to a macro?

I know to allow multiple selection is something like Target.Count > 1 . How can we incorporate if the user deletes multiple cells? Also, would that work if the user decides to delete a whole row or column?

Thanks!

 

[Fluff]

Something along the lines of

Sub DelCells()
Dim Cl As Range
For Each Cl In Selection.Areas
   Cl.Delete
Next Cl
End Sub

 

[JessWhyCuh]

So this needs to be allowed when the user makes a change in the worksheet. That code in the above post works fine, but not what I'm having trouble with. However, I found where my code gets an error which is when the user deletes more than 1 selection the error occurs with Target.Value in the worksheet_change sub. Is there a way to fix this error? Since it is multiple cells (or targets) that are being deleted, it is not just one value it is a selection. Is there a target.selection method or some sort?

Or anyone have any ideas about how to delete the cells for the user? I wouldn't want a msgbox to appear each time the user selects multiple cells...

I know this seems so specific, so my apologies :/

 

[Fluff]

It would help if you posted your code.

 

[JessWhyCuh]

It is pretty long...

Private Sub Worksheet_Change(ByVal Target As Range)

'Highlight cells according to date
    If Not Intersect(Target, Range("H5:AA16")) Is Nothing Then
        If IsEmpty(Target) = True Then
            With Target
                .Style = "Normal"
                .HorizontalAlignment = xlCenter               'keep cell format
                .VerticalAlignment = xlCenter
                .BorderAround xlContinuous, xlThin
                With .Font
                    .Name = "Calibri"
                    .Size = 11
                End With
            End With
        ElseIf Target.Value < Date Then
            Target.Style = "Bad"
        ElseIf Target.Value = "-" Then
            'do nothing
        ElseIf Target.Value > Date Then
            Target.Style = "Good"
        ElseIf Target.Value = Date Then
            Target.Interior.ColorIndex = 0
            Target.Font.ColorIndex = 1
        End If
    End If

'Auto populate 
    If Not Intersect(Target, Range("Q5:Q16")) Is Nothing Then
        If IsEmpty(Target) = True Then
            'do nothing
        ElseIf IsEmpty(Target) = False Then
            Application.EnableEvents = False 'Prevent looping based on change caused by auto pop
            Target.Cells(1, 2).Value = DateAdd("d", 60, Target.Value)
                If Target.Cells(1, 2).Value < Date Then
                    Target.Cells(1, 2).Style = "Bad"
                ElseIf Target.Cells(1, 2).Value > Date Then
                    Target.Cells(1, 2).Style = "Good"
                ElseIf Target.Cells(1, 2).Value = Date Then
                    Target.Cells(1, 2).Interior.ColorIndex = 0
                    Target.Cells(1, 2).Font.ColorIndex = 1
                End If
            Application.EnableEvents = True 'Allow events again
        End If
    End If

'Auto populate 
    If Not Intersect(Target, Range("M5:M16")) Is Nothing Then
        If IsEmpty(Target) = True Then
            'do nothing
        ElseIf IsEmpty(Target) = False Then
            Application.EnableEvents = False
            Target.Cells(1, 2).Value = DateAdd("d", 7, Target.Value)
                If Target.Cells(1, 2).Value < Date Then
                    Target.Cells(1, 2).Style = "Bad"
                ElseIf Target.Cells(1, 2).Value > Date Then
                    Target.Cells(1, 2).Style = "Good"
                ElseIf Target.Cells(1, 2).Value = Date Then
                    Target.Cells(1, 2).Interior.ColorIndex = 0
                    Target.Cells(1, 2).Font.ColorIndex = 1
                End If
            Target.Cells(1, 3).Value = DateAdd("d", 1, Target.Cells(1, 2).Value)
                If Target.Cells(1, 3).Value < Date Then
                    Target.Cells(1, 3).Style = "Bad"
                ElseIf Target.Cells(1, 3).Value > Date Then
                    Target.Cells(1, 3).Style = "Good"
                ElseIf Target.Cells(1, 3).Value = Date Then
                    Target.Cells(1, 3).Interior.ColorIndex = 0
                    Target.Cells(1, 3).Font.ColorIndex = 1
                End If
            Application.EnableEvents = True
        End If
    End If

'Auto populate 
    If Not Intersect(Target, Range("N5:N16")) Is Nothing Then
        If IsEmpty(Target) = True Then
            'do nothing
        ElseIf IsEmpty(Target) = False Then
            Application.EnableEvents = False
            Target.Cells(1, 2).Value = DateAdd("d", 1, Target.Value)
                If Target.Cells(1, 2).Value < Date Then
                    Target.Cells(1, 2).Style = "Bad"
                ElseIf Target.Cells(1, 2).Value > Date Then
                    Target.Cells(1, 2).Style = "Good"
                ElseIf Target.Cells(1, 2).Value = Date Then
                    Target.Cells(1, 2).Interior.ColorIndex = 0
                    Target.Cells(1, 2).Font.ColorIndex = 1
                End If
            Application.EnableEvents = True
        End If
    End If

'Change to a late date to today or future date gives risk to need date
    If Not Intersect(Target, Range("H5:V16")) Is Nothing Then
        Application.EnableEvents = False
            If PrevDate < Date Then 'here
                If Target.Value = "-" Then
                    With Target
                        .Style = "Normal"
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                        .BorderAround xlContinuous, xlThin
                        With .Font
                            .Name = "Calibri"
                            .Size = 11
                        End With
                    End With
                ElseIf Target >= Date Then
                    Cells(Target.Row, "W").Style = "Neutral"
                End If
            End If
        Application.EnableEvents = True
    End If

End sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Count > 1 Then                                'allow multiple selection bc received error
        Exit Sub
    ElseIf Target.Count = 1 Then                            
        If IsEmpty(Target) = True Then
            PrevDate = Date
        ElseIf IsDate(Target) = False Then
            Exit Sub
        ElseIf Target.Style = "Bad" Then
            PrevDate = Target.Value
        ElseIf Target.Style = "Good" Then
            PrevDate = Target.Value
        ElseIf Target.Style = "Normal" Then
            PrevDate = Target.Value
        End If
    End If

End Sub

 

[Fluff]

From what I can see there is nothing in that code that is trying to delete anything.

 

[JessWhyCuh]

Right...

The code is not suppose to delete the cell. The code will run when the user deletes multiple cells. With this code, I receive in error and VBA asks me to debug a line that contains a Target.Value in the first set of if statements from worksheet_change sub.

Maybe if I tried n nested if saying if target is empty (meaning the user deleted the multiple cells) then target.value equals blank. Or something like that...?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Count > 1 Then                                'allow multiple selection bc received error
        'added IF statement mentioned above
        Exit Sub

 

[Fluff]

If the user selects more than 1 cell then the code will exit & you should not get any errors

 

[JessWhyCuh]

Oh, my bad! It shouldn't go there because that's not where the error is occurring. Right, so the error happens in the first set of If statements in worksheet_change sub. After the user deletes the cells in the multiple selection, how come the "If IsEmpty(Target) =True Then" line from the first set of Ifs doesn't work? It's because there's more than 1 cell selected? Is there a method to say target selection or, could I do a "For each cl in Target" instead?

I think that might work...? We'll see

EDIT: FOR LOOP WORKS WOW (I'm a newbie)

 

[Fluff]

Glad you got it sorted & thanks for the feedback