Preventing/Limiting User from Deleting Data Out of Specified Range

[ybr_15]

Hi dear,

I have this code to delete data based on selection range:

Sub DeleteSelection()
    Dim myrange As Range

    On Error Resume Next
    Set myrange = Application.InputBox(Prompt:="Select your range:", Title:="Delete Data", Type:=8)
    If Not myrange Is Nothing Then
        myrange.ClearContents
    End If
End Sub

Now, I want to add a condition to delete data so that users can only delete data in the specified area, eg. Range (A5:C100) and Range (F5:H50). Users are not permitted to delete data outside that range (event though it is intersect). Can anyone here help me? Thanks

 

[Yongle]

Try replacing

myRange.ClearContents

with

Intersect( myRange, Range("A5:C100") ).ClearContents
Intersect( myRange, Range("F5:H50") ).ClearContents

or do you only want user to be able to delete from ONE of the ranges ?
If so, how does VBA know which range to choose ?
Should user make decision based on reply to a message ?
or delete from first range only ?

 

[ybr_15]

Hi Yongle,

What I want is users free to delete data based on his/her SELECTION in the Range (A5:C100) and Range (F5:H50). But, if their SELECTION is OUT OF RANGE or INTERSECT out of specified range (Range (A5:C100) and/or Range (F5:H50)) then the data will not be deleted. User only ALLOWED to delete data if their SELECTION is WITHIN the specified range.

Example:
If user want to delete range(A5:D5) then data will not be deleted because selection is intersect D5 (which is out of the specified range). But, if they want to delete range(A5:C5) then the data will be deleted because selection is within the specified range. Can it be done with vba? Thanks

 

[Yongle]

One way

Sub DeleteSelection()
    Dim myRange As Range, C As Long, C10 As Long, C20 As Long
    On Error Resume Next
    Set myRange = Application.InputBox(Prompt:="Select your range:", Title:="Delete Data", Type:=8)
    C = myRange.Count
    C10 = Intersect(Range("A5:C300"), myRange).Count
    C20 = Intersect(Range("F5:H50"), myRange).Count
    If C10 > 0 And C = C10 Then
        myRange.ClearContents
    ElseIf C20 > 0 And C = C20 Then
        myRange.ClearContents
    End If
End Sub

 

[ybr_15]

Hi Yongle,

Thanks for your help but your code doesn't work the way I want it to. Just now, I tried (reads and trials) and finally got it:

Sub DeleteSelection()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim shtReference As Worksheet
    Dim rngMyRange As Range
    Dim rngIntersect As Range

    Set shtReference = wb.Sheets("MyData")
    
    On Error Resume Next
    Set rngMyRange = Application.InputBox(Prompt:="Select your range:", Title:="Delete Data", Type:=8)
    Set rngIntersect = Application.Intersect(rngMyRange, shtReference.Range("Range_Data"))
    If Not rngIntersect Is Nothing Then
        If Not rngMyRange Is Nothing Then
            With rngIntersect [COLOR=#008080]' I think this is the problem because I choose [/COLOR][COLOR=#8b4513]rngMyRange[/COLOR][COLOR=#008080] instead of [/COLOR][COLOR=#8b4513]rngSelect[/COLOR][COLOR=#008080] before[/COLOR]
                .ClearFormats
                .ClearContents
            End With
        End If
    End If
End Sub

Once again, thanks for your help. Sorry if my question is confusing (I still learn a lot about VBA )

 

[Yongle]

Is your problem now resolved?