exact sequence in certain cells?

[AwesomeSteph]

I am looking for a VBA to only allow an exact sequence for instance if cells in column A aren't typed in containing "A-12-34-5678-01AAA-123A-B" with same number of numbers between dashes then they get an error and it is deleted. Any suggestions?

 

[dreid1011]

I'm not sure if this can be done the way you want it to be done. I am thinking about checking the entered value to see if it starts with "=" and then delete it? That can be added to the beginning of the code before it checks for the pattern.

Edit: See if this does what you want

Sub Worksheet_Change(ByVal Target As Range)
Dim a As Range
Dim sMatch As Boolean
Set a = Range("G5:G6969")
Application.EnableEvents = False
If Left(Target.Value, 1) = "=" Then
    Target.ClearContents
Else
    If Not Intersect(Target, a) Is Nothing Then
        sMatch = Target.Value Like "##-##-####-##[A-Z][A-Z][A-Z]-###[A-Z]-[A-Z]"
        If Not sMatch Then Target.ClearContents
    End If
End If
Application.EnableEvents = True
End Sub

 

[AwesomeSteph]

That didn't work. I would be more interested in turning off the ability for anyone to use the paste function in this workbook.
My biggest problem is that once I test it by copying from another sheet (or even this one just copying anything and trying to paste) once pasted even if an error pops up the macro no longer works at all meaning all of column G can be entered without using the pattern required.

 

[dreid1011]

It's working for me using ctrl+c / ctrl+v and copying the cell contents directly from the formula bar. How are the formulas being pasted?

Perhaps something like this(replace what I provided earlier with all the red portion below):

This will not disable copy/paste but should undo any copy/paste done on the sheet.

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 18 Apr 2017

    Dim UndoList As String

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    On Error GoTo ErrExit    UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1)
    If Left(UndoList, 5) = "Paste" Or UndoList = "Auto Fill" Then
        With Application
            .Undo
            .CutCopyMode = False
        End With
        Target.Select
    End If

Dim a As Range
Dim sMatch As Boolean
Set a = Range("G5:G6969")
    If Not Intersect(Target, a) Is Nothing Then
        sMatch = Target.Value Like "##-##-####-##[A-Z][A-Z][A-Z]-###[A-Z]-[A-Z]"
        If Not sMatch Then Target.ClearContents
    End If


ErrExit:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Found here: https://stackoverflow.com/questions/43467716/vba-disable-copy-paste

 

[AwesomeSteph]

Thank you for your fast input! I found https://www.extendoffice.com/documents/excel/4289-excel-disable-cut-copy-paste.html and it is working for now. I have to get this out to the users asap so I will take a look at yours a little later and see if I can get it integrated tomorrow. thank you again for all your help it is very much appreciated!!

 

[dreid1011]

You're welcome. Let me know how it goes.

 

[AwesomeSteph]

So I am now trying to apply this same code to another project and it is unsuccessful. The code used previously works fine on it's own but once I ad this bit about the sMatch I get errors on the clear contents line. Any ideas?

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False


If [B4].Value <> "" And [B6].Value <> "" And [B8].Value <> "" And [B10].Value <> "" And [B16].Value <> "" And [B18].Value <> "" And [F4].Value <> "" And [G5].Value <> "" Then
        Sheet3.Visible = True
        Sheet4.Visible = True
        Sheet6.Visible = True
        Sheet7.Visible = True
        Sheet8.Visible = True
    Else
        Sheet3.Visible = xlVeryHidden
        Sheet4.Visible = xlVeryHidden
        Sheet6.Visible = xlVeryHidden
        Sheet7.Visible = xlVeryHidden
        Sheet8.Visible = xlVeryHidden
        Sheet13.Visible = xlVeryHidden
End If


If [B4].Value <> "" And [B6].Value <> "" And [B8].Value <> "" And [B10].Value <> "" And [B16].Value <> "" And [B18].Value <> "" And [F4].Value <> "" And [G5].Value <> "" Then
    CommandButton10.Visible = True
Else
    CommandButton10.Visible = False
End If


Dim a As Range
Dim sMatch As Boolean
Set a = Range("B8")
Application.EnableEvents = False
If Not Intersect(Target, a) Is Nothing Then
    sMatch = Target.Value Like "##-##-####-##[A-Z][A-Z][A-Z]"
    If Not sMatch Then Target.ClearContents
End If


Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[dreid1011]

What error are you receiving?

 

[AwesomeSteph]

run-time 13 mismatch

 

[dreid1011]

What value and format is B8? I just copied this and it seems to be working just fine.

 

[AwesomeSteph]

Just general nothing fancy.