prevent add a new sheet based on cell value

[MKLAQ]

hi

I would add some lines to this code when I add a new sheet if from the first time then should add and if I repeat again add a new sheet then should prevent add a new sheet until change the value in D3 it shouldn't add a new sheet contains for the same value in d3 for more than sheet .

Sub CreateNewSheet()
Dim dDate As Long
Dim oNum As String
Dim lst As Long

sheet1.Copy After:=Sheets(Sheets.Count)

With ActiveSheet
    dDate = .Range("B3").Value
    oNum = .Range("D3").Value
    lst = .Range("A" & Rows.Count).End(xlUp).Row
    .Columns(3).Insert
    .Columns("1").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    .Range("A4").Value = "date"
    .Range("D4").Value = "order"
    .Range("A5:A" & lst).Value = Format(dDate, "dd/mm/yyyy")
    .Range("D5:D" & lst).Value = oNum
    .Rows("1:3").Clear
End With
End Sub

any help will truly appreciate

 

[MKLAQ]

as to your code when I add a new sheet it shows me the message I have to change in d3 it's it' should not show the message in first time when I add a new sheet because based on my orginal code . it create headers and repeat values in some columns when I add a new sheet that's why I want I add a new sheet from the first time but when I change the value in d3 it still show message I can't add a new sheet despite I changed in d3 .

do you understand me what's the problem I face it.

 

[GWteB]

Hopefully I've nailed it with the code below ...

Sub CreateNewSheet_r3()

    Dim dDate As Long
    Dim oNum As String
    Dim lst As Long

    Dim Ws         As Worksheet
    Dim Proceed    As Boolean

    With Sheet1
        Proceed = True
        oNum = .Range("D3").Value
        For Each Ws In ThisWorkbook.Worksheets
            If Ws.Name <> .Name Then
                If Ws.Range("D5").Value <> oNum Then
                    Proceed = True
                Else
                    Proceed = False
                    Exit For
                End If
            End If
        Next Ws

        If Proceed Then

            .Copy After:=Sheets(Sheets.Count)
            With ActiveSheet
                dDate = .Range("B3").Value
                oNum = .Range("D3").Value
                lst = .Range("A" & Rows.Count).End(xlUp).Row
                .Columns(3).Insert
                .Columns(1).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                .Range("A4").Value = "date"
                .Range("D4").Value = "order"
                .Range("A5:A" & lst).Value = Format(dDate, "dd/mm/yyyy")
                .Range("D5:D" & lst).Value = oNum
                .Rows("1:3").Clear
            End With
        Else
            
            MsgBox "Please change order number.", vbExclamation
        End If
    End With
End Sub

 

[MKLAQ]

fantasic ! you're genuis
thanks so much for a great assistance

 

[GWteB]

Sometimes patience pays off ...
You're welcome and thanks for the feedback.