Verifying partial Worksheet name before running or if no match exit macro

[Bill Williamson]

I have a macro I run on an export sheet from another program. I am worried that if this were ever accidentally run
with the wrong window open in excel it could do some damage to any other worksheet.

I would like the code to only work with worksheets named "JobOperationsExport43" but excluding the number because it changes.

I believe I have to declare the worksheet name as a variable, and verify in an if than statement but i am not sure.

Any help would be appreciated.
Thanks,

Bill Williamson

below is the code I use.

Sub SitelineDataMacro()
'
' Siteline Data Macro
' Shorten Data File from Siteline
'
' Keyboard Shortcut: Ctrl+g



' Verify worksheet name or exit macro






ActiveSheet.Name = "export"
Application.ScreenUpdating = False
    Columns("A:B").Select
    Selection.ClearContents
    Selection.Delete Shift:=xlToLeft
    Columns("B:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("C:AA").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:S").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:V").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=-3
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("E4").Select
    Columns("B").Select
    Selection.Cut
    Columns("D").Select
    Selection.Insert Shift:=xlToRight
    
'Removes "J" from Job Numbers
    Columns("A").Select
    Selection.Replace "j", ""
    Cells.Range("A1").Select
    Selection.Replace "ob", "Job#"
 
 'Renames Part Number
    Columns("C").Select
    Selection.Replace "item", "Part#"
 
 'Renames Quantity
    Columns("D").Select
    Selection.Replace "Received", "Quantity"
    
  
 'Delete any Row that Part Number ends in "C"
 
    Dim lr As Long, i As Long
    lr = Range("C" & Rows.Count).End(xlUp).Row
    For i = lr To 1 Step -1
        If InStr(Range("C" & i), "C") > 0 Then
            Range("C" & i).EntireRow.Delete
        End If
    Next i
    ActiveSheet.Columns("A:B").Insert Shift:=xlToRight
    ActiveSheet.Name = "Export"


'Message boxes for Customer and CSO entry

    Dim CSO As String, Customer As String
    CSO = InputBox("CSO #")
    Customer = InputBox("Customer Name")
    Range("A2").Value = CSO
    Range("B2").Value = Customer
    Range("A1:B1").Value = Array("CSO#", "Customer")
    [A2].Resize(Range("C" & Rows.Count).End(xlUp)(0).Row, 2).Value = Array(CSO, Customer)
    Columns("C").Select
    Selection.Cut
    Columns("B").Select
    Selection.Insert Shift:=xlToRight
    
    
 

'Centers Resizes and Aligns Data to Correct Format
     Cells.Select
    With Selection
        .EntireColumn.AutoFit
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
  
 

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "C:\Test\Testworkbook.xlsx", FileFormat:=51
Workbooks.Open Filename:= _
        "C:\Users\Billw\Desktop\QA Documents\Stainless Data Entry 120519.xlsm"
      


'Find the last used row in both sheets and copy and paste data below existing data.

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long

  'Set variables for copy and destination sheets
  Set wsCopy = Workbooks("Testworkbook.xlsx").Worksheets("Export")
  Set wsDest = Workbooks("Stainless Data Entry 120519.xlsm").Worksheets("Data")

  ' Find last used row in the copy range based on data in column A
  lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row

  ' Find first blank row in the destination range based on data in column C
  'Offset property moves down 1 row
  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "C").End(xlUp).Offset(1).Row

  'Copy& Paste Data
    wsCopy.Range("A2:F" & lCopyLastRow).Copy
    wsDest.Range("C" & lDestLastRow).PasteSpecial
    
    
    
    'Date Stamp and column Numbering
    Range("B" & lDestLastRow & ":B" & lDestLastRow + lCopyLastRow - 2).Value = Date
    Range("A" & lDestLastRow & ":A" & lDestLastRow + lCopyLastRow - 2).Formula = "=r[-1]c+1"
 
 
 
    Workbooks("Testworkbook.xlsx").Close False
  
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    
    MsgBox "Data Transferred"
    
    'Set Print area and print data range pasted to worksheet
    
    ActiveWindow.RangeSelection.PrintOut
    
 
  
  'ActiveWorkbook.Save
  'Application.Quit
  'Workbooks.ThisWorkbook.Close SaveChanges:=True
  'Filename:= _
        "C:\Users\Billw\Desktop\QA Documents\Stainless Data Entry 120519.xlsm"
 
  
  
End Sub

 

[offthelip]

try this:

Sub test()

Sname = ActiveSheet.Name

If Left(Sname, 19) = "JobOperationsExport" Then

Call SitelineDataMacro

End If

End Sub

 

[Fluff]

Maybe

If Not ActiveSheet.Name Like "JobOperationsExport*" Then Exit Sub

 

[Bill Williamson]

Thank you both for your quick replies to my problem,
because I am using a short cut to run my macro I went with the Code that Fluff provided.
I knew where to put it in my code.
I ran a couple of tests and it is working great. Thank you both for your help


Best Regards and hats off to all those that help on here.

Bill Williamson

 

[Fluff]

Glad we could help & thanks for the feedback