Check if sheetname exists before create

[Vincent88]

I run my code to duplicate a worksheet. If the worksheet is already existed , then no duplication of sheet and message box (Sheet (sheetname) does exists) will show. But this message box will also pop up when new sheet is created but I do not want this. I only want this msg box to pop up when I run the marco again and found the same sheetname already there. Please help.

Function DoesSheetExists(sh As String) As Boolean
    Dim ws As Worksheet

    On Error Resume Next
       Set ws = Sheets(sh)
    On Error GoTo 0

    If Not ws Is Nothing Then DoesSheetExists = True
End Function

Sub Check()
     Dim szToday As String
     szToday = Format(Date, "d mmm yyyy")
    

    If DoesSheetExists(szToday) Then
        MsgBox "Sheet " & szToday & " does exists"
     Else
         Call Module18.BlankSheet03
         MsgBox "Sheet" & szToday & " Created"
    End If
End Sub

 

[Vincent88]

Hi HaHoBe,
With some help, I settled the cell movement. The last thing left is how to limit the "Range Content Applications" applies to cell with prefix only. I tried using instr function but it does not work. Please !

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Select Case Sh.Name
Case "Agents"
Exit Sub
Case Else
End Select

'Range Content Applications

If Target.Column > 4 Or Target.CountLarge > 1 Then Exit Sub
If Target.Row = 1 Then Exit Sub

Application.EnableEvents = False
If Cells(Target.Row, "A") <> "" And Cells(Target.Row, "B") <> "" Then

'If InStr(1, Cells(Target.Row, "A"), "REQ000000") <> "" And Cells(Target.Row, "B") <> "" Then

Cells(Target.Row, "C") = ActiveSheet.Name
Cells(Target.Row, "C").Font.Name = "Times New Roman"
Cells(Target.Row, "C").Font.Size = 12
Cells(Target.Row, "C").HorizontalAlignment = xlRight
Cells(Target.Row, "D").ShrinkToFit = True
Cells(Target.Row, "A").Font.Name = "Times New Roman"
Cells(Target.Row, "A").Font.Size = 12
Cells(Target.Row, "A").HorizontalAlignment = xlLeft
Cells(Target.Row, "B").Font.Name = "Times New Roman"
Cells(Target.Row, "B").Font.Size = 12
Cells(Target.Row, "B").HorizontalAlignment = xlLeft

End If


'Formate Column A

If Target.Column = 1 Then
Dim s As String
Dim arr As Variant

s = Target.Value
If s = "" Then
Target.NumberFormat = "General"
Else
With CreateObject("vbscript.regexp")
.Pattern = "[^0-9]"
.Global = True
.IgnoreCase = True
arr = Split(Application.Trim(.Replace(s, " ")), " ")
End With
Target.Value = arr
Target.Value = Target.Value * 1
Target.NumberFormat = """REQ0000000""General"
End If
End If


'Set Cell Movement within The Range

If Target.CountLarge > 1 Then Exit Sub
Dim rng As Range
Set rng = Range("A1").CurrentRegion
If rng.Rows.Count > 1 Then
Set rng = Intersect(Target, rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count))
Else
Set rng = Nothing
End If
If Not rng Is Nothing Then
If Target.Column = 2 And Not (IsEmpty(Target)) Then
Target.Offset(, 2).Select
Else
Target.Offset(, 1).Select
End If
End If

Application.EnableEvents = True

End Sub