Vb Code to work in "save as file" and not work in "original file"

[ateebali]

Dear Sir
I need help, I am using following code to save as new file;

Sub filename_cellvalue()ActiveWorkbook.Save
Dim SourceWB As Workbook
Dim NewWB As Workbook
Dim strPath As String
Dim FileName As String


If Dir(ThisWorkbook.Path & "\Backup", vbDirectory) = vbNullString Then MkDir ThisWorkbook.Path & "\Backup"
Path = ThisWorkbook.Path & "\Backup" & "\"


With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With


Set SourceWB = ActiveWorkbook


With SourceWB
    .Save
    FileName = .Sheets("Summary").Range("T1").Value
    If Dir(.Path & "\Backup", vbDirectory) = vbNullString Then MkDir .Path & "\Backup"
    strPath = .Path & "\Backup\"
    .SaveCopyAs (strPath & FileName & ".xlsb")
End With


Workbooks.Open (strPath & FileName & ".xlsb")


Set NewWB = ActiveWorkbook


With NewWB




For sh = 1 To Sheets.Count
Sheets(sh).Visible = -1
Next sh




Application.DisplayAlerts = False
Sheets(Array("Reports", "Consolidated Report", "Welcome")).Delete
Application.DisplayAlerts = True
   
Sheets("New Style").Shapes.Range(Array("ColorA3")).Delete
Sheets("New Style").Shapes.Range(Array("ColorA3")).Delete
    
Sheets("Garment Detail").Shapes.Range(Array("ColorA3")).Delete
Sheets("Garment Detail").Shapes.Range(Array("ColorA3")).Delete


Sheets("Picture").Shapes.Range(Array("ColorA3")).Delete
Sheets("Picture").Shapes.Range(Array("ColorA3")).Delete
    
Sheets("Operations").Shapes.Range(Array("ColorA3")).Delete
Sheets("Operations").Shapes.Range(Array("ColorA3")).Delete
 
Sheets("Layout").Shapes.Range(Array("ColorA3")).Delete
Sheets("Layout").Shapes.Range(Array("ColorA3")).Delete
     
Sheets("Report").Shapes.Range(Array("ColorA3")).Delete
Sheets("Report").Shapes.Range(Array("ColorA3")).Delete
       
Sheets("Summary").Shapes.Range(Array("ColorA3")).Delete
Sheets("Summary").Shapes.Range(Array("Button 553")).Delete
Sheets("Summary").Shapes.Range(Array("Button 554")).Delete
Sheets("Summary").Shapes.Range(Array("Button 555")).Delete
Sheets("Summary").Shapes.Range(Array("Button 556")).Delete
Sheets("Summary").Shapes.Range(Array("Button 627")).Delete


Sheets("Short").Select
ActiveWindow.SelectedSheets.Visible = False


End With


NewWB.Close SaveChanges:=True


With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

Already below code is save as Thisworkbook VB Project, I want it to work on save as file but not to work on original file;

Public Sub Workbook_Open()  Dim Rng As Range
  Set Rng = ThisWorkbook.Sheets("Summary").Range("C56")
  
    With Rng
        .Value = .Value + 1
    End With
    
End Sub

 

[John_w]

Maybe change the Workbook_Open in the original workbook to something like this:

Public Sub Workbook_Open()  
    Dim Rng As Range
    
    If Instr(ThisWorkbook.Path, "\Backup\") Then
        Set Rng = ThisWorkbook.Sheets("Summary").Range("C56")
        With Rng
            .Value = .Value + 1
        End With
    End If
    
End Sub

so that the innards only run if the workbook is in the Backup folder.

 

[ateebali]

great sir, thanks a lot