Copy worksheet but the new worksheet to omit some items

[ipbr21054]

Hi,
I have a worksheet which has some command buttons on etc.
In the code used below i copy this worksheet to create another worksheet where the customers name is used for the sheet name,ALL COMMAND BUTTONS ARE ALSO COPIED OVER.
Once the job is complete the user will go to the sheet which has the relevant customers name on it & run the command button for which it prints & deletes it.

The above works fine BUT sometimes the user will press a command button that they do not need to.
The only button they should press is the one that prints then deletes it,simples ha ha ha

I aim to hide all the command buttons that do not need to be on the copied worksheet & thus just showing the one used for printing / deleting.

Using the code like Command1.Visible = False works fine.
So i just did this for all the items in question But it hid all the items on the main worksheet & not the copied worksheet.

Please advise how to do this,bearing in mind each copied worksheet is name after the customer.

Not sure if i should be using With sheets "CUSTOMERS NAME" because dont know how to code it if customers name will change every time

Private Sub Generate_Pdf_Click()
  Dim answer As Integer
  Dim sPath As String, strFileName As String
  Dim wks As Worksheet
  Set wks = ActiveSheet
  
  
  With ActiveSheet
  If Range("G13") = "" Then
    MsgBox "NO NAME SELECTED IN THE CUSTOMER DETAILS SECTION", vbCritical, "NO CUSTOMER SELECTED MESSAGE"
    Range("G13").Select 'CHECKING IF CUSTOMER IS SELECTED
  Exit Sub
  End If
  
  If Range("L18") = "" Then
    MsgBox ("PLEASE SELECT A PAYMENT TYPE "), vbCritical, "PAYMENT TYPE WAS NOT SELECTED"
    Range("L18").Select 'CHECKING IF PAYMENT TYPE HAS BEEN SELECTED
  Exit Sub
  End If
  
  strFileName = "C:\Users\Ian\Desktop\REMOTES ETC\DR\DR COPY INVOICES\" & Range("L4").Value & ".pdf"
  With ActiveSheet
      .ExportAsFixedFormat Type:=xlTypePDF, fileName:=strFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
  End With 'CURRENT INVOICE IS NOW SAVED
   
  With Sheets("DATABASE")
      Worksheets("DATABASE").Activate
  End With

  Set rng = ActiveSheet.Columns("A:A")
    findString = Worksheets("INV").Range("G13").Value
  Set cell = rng.Find(What:=findString, LookIn:=xlFormulas, _
    LookAt:=xlWhole, MatchCase:=False) ' CUSTOMER FOUND IN COLUMN A
   
  If cell Is Nothing Then
    MsgBox "NO CUSTOMER WAS FOUND"
  Else
  With Sheets("DATABASE")
    cell.Select
    ActiveCell.Offset(0, 15).Select ' CUSTOMERS CELL IN COLUMN P NOW SELECTED
  End With
  End If
    
  If Len(ActiveCell.Value) <> 0 Then
       ValueInInvoiceCell.Show 'MESSAGE SHOWN IF CUSTOMERS INVOICE CELL IN COLUMN P HAS A VALUE IN IT

  Exit Sub
  Else
       TransferInvoiceNumber.Show 'NOW ENTER INVOICE NUMBER IN CUSTOMERS CELL IN COLUMN P & NOW HYPERLINKED
  End If
    
    With Sheets("DATABASE")
      Worksheets("INV").Activate 'WORKSHEET INVOICE HAS NOW BEEN ACTIVATED
      End With
  With ActiveSheet
  MsgBox "PRINTING DISIBLED"
      'ActiveWindow.SelectedSheets.PrintOut copies:=1
  End With

  
  ActiveSheet.Copy After:=Worksheets(Sheets.Count)
  If wks.Range("G13").Value <> "" Then
  On Error Resume Next
  ActiveSheet.NAME = wks.Range("G13").Value 'NEW COPY WORKSHEET NOW CREATED
  End If
  End With
    
  wks.Activate
     Range("L4").Value = Range("L4").Value + 1 'INVOICE IS INCREMATED BY 1
     Range("G27:L36").ClearContents   'WORKSHEET DETAILS NOW CLEARED
     Range("G46:G50").ClearContents
     Range("L18").ClearContents
     Range("G13").ClearContents
     Range("G13").Select
     ActiveWorkbook.Save

  Call PasteIfFormulas_Click
  ActiveWorkbook.Save
  
  
  End Sub

 

[Tupe77]

' ***** REPLACE ORIGINAL "Sub Generate_Pdf_Click()" in INV -Sheet module WITH THIS ONE New part start *******************************************************
Private Sub Generate_Pdf_Click() 
  Dim answer As Integer
  Dim sPath As String, strFileName As String, findString As String
  Dim cell As Range, rng As Range
' Define the original sheet
Dim wks As Worksheet
Set wks = Worksheets("INV")
  
  
 With wks
  If .Range("G13") = "" Then
    MsgBox "NO NAME SELECTED IN THE CUSTOMER DETAILS SECTION", vbCritical, "NO CUSTOMER SELECTED MESSAGE"
    .Range("G13").Select 'CHECKING IF CUSTOMER IS SELECTED
    Exit Sub
  End If
  
  If .Range("L18") = "" Then
    MsgBox ("PLEASE SELECT A PAYMENT TYPE "), vbCritical, "PAYMENT TYPE WAS NOT SELECTED"
    .Range("L18").Select 'CHECKING IF PAYMENT TYPE HAS BEEN SELECTED
    Exit Sub
  End If

  strFileName = "C:\Users\Ian\Desktop\REMOTES ETC\DR\DR COPY INVOICES\" & Range("L4").Value & ".pdf"
 End With
 
 With wks
      .ExportAsFixedFormat Type:=xlTypePDF, fileName:=strFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
 End With 'CURRENT INVOICE IS NOW SAVED
   
Worksheets("DATABASE").Activate

  Set rng = Worksheets("DATABASE").Columns("A:A")
    findString = Worksheets("INV").Range("G13").Value
  Set cell = rng.Find(What:=findString, LookIn:=xlFormulas, _
    LookAt:=xlWhole, MatchCase:=False) ' CUSTOMER FOUND IN COLUMN A
   
  If cell Is Nothing Then
    MsgBox "NO CUSTOMER WAS FOUND"
  Else
      With Sheets("DATABASE")
        cell.Select
        ActiveCell.Offset(0, 15).Select ' CUSTOMERS CELL IN COLUMN P NOW SELECTED
      End With
  End If
    
  If Len(ActiveCell.Value) <> 0 Then
' NEXT line is NOT tested
       ValueInInvoiceCell.Show 'MESSAGE SHOWN IF CUSTOMERS INVOICE CELL IN COLUMN P HAS A VALUE IN IT
    Exit Sub
  Else
' NEXT line is NOT tested    
       TransferInvoiceNumber.Show 'NOW ENTER INVOICE NUMBER IN CUSTOMERS CELL IN COLUMN P & NOW HYPERLINKED
  End If    
  
  Worksheets("INV").Activate 'WORKSHEET INVOICE HAS NOW BEEN ACTIVATED

  With wks
    MsgBox "PRINTING DISIBLED"
      'ActiveWindow.SelectedSheets.PrintOut copies:=1
  End With

Call HideButtons ' Performs copying, naming and hiding buttons.
    
  wks.Activate
    with wks
     .Range("L4").Value = Range("L4").Value + 1 'INVOICE IS INCREMATED BY 1
     .Range("G27:L36").ClearContents   'WORKSHEET DETAILS NOW CLEARED
     .Range("G46:G50").ClearContents
     .Range("L18").ClearContents
     .Range("G13").ClearContents
     .Range("G13").Select
    End with
' NEXT line is NOT tested
     ActiveWorkbook.Save

' NEXT line is NOT tested
  Call PasteIfFormulas_Click
  
 ' NEXT line is NOT tested
  ActiveWorkbook.Save 
  
  End Sub
 ' ***** REPLACE ORIGINAL "Sub Generate_Pdf_Click()" in INV -Sheet module WITH THIS ONE New part end *******************************************************

 ' ***** COPY THIS PART TO NORMAL VBA MODULE start ******************************************************************************************************
Option Explicit

Sub HideButtons()
On Error GoTo ErrHand:
Call TurnOffFeatures ' Stop events etc...

' Define the original sheet
Dim wks As Worksheet
Set wks = Worksheets("INV")

' Define the copied sheet
If wks.Range("G13").Value <> "" Then                    ' if name
    wks.Copy After:=Worksheets(Sheets.Count)    ' Copy to last sheets
    Worksheets(Sheets.Count).Name = wks.Range("G13").Value           ' rename sheet
    Dim wksNew As Worksheet
    Set wksNew = Worksheets(wks.Range("G13").Value)     ' set wksNew as new sheet (Selected by name: I would recommend using this)
End If

' Hide all others CommanButtons except "PrintGeneratedSheet"
Dim Shape As Shape
For Each Shape In wksNew.shapes
    If Shape.Name <> "PrintGeneratedSheet" Then
        Shape.Visible = False
    End If
Next

ErrHand:
    Call TurnOnFeatures ' Enable events etc...
End Sub

Public Function TurnOffFeatures() ' Stop events etc...
Application.Calculation = xlManual
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
End Function

Public Function TurnOnFeatures() ' Enable events etc...
Application.Calculation = xlAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Function
 ' ***** COPY THIS PART TO NORMAL VBA MODULE end ******************************************************************************************************

My apologies for any quirks, English is not my native language. "So I blame Google translate for all my goofs."

 

[ipbr21054]

This seems to do it now so tomorrow will test it properly
Thanks