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

Bill Williamson

Board Regular
Joined
Oct 7, 2019
Messages
124
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.
VBA Code:
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
 

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,492
Office Version
  1. 2010
Platform
  1. Windows
try this:
VBA Code:
Sub test()

Sname = ActiveSheet.Name

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

Call SitelineDataMacro

End If

End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,125
Office Version
  1. 365
Platform
  1. Windows
Maybe
VBA Code:
If Not ActiveSheet.Name Like "JobOperationsExport*" Then Exit Sub
 

Bill Williamson

Board Regular
Joined
Oct 7, 2019
Messages
124
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,125
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,114,013
Messages
5,545,487
Members
410,685
Latest member
chandraganji
Top