New to VBA - Copy paste template if cell contains certain value

[New_Excel_VBA_User]

Hi everyone,

This is kind of like asking someone to tell me about the Universe, but i'm new to VBA and have been looking into it more (purchasing books) to get started as I'm seeing a massive need to help with my daily job functions. One I'm primarily looking at is trying to copy a template worksheet and renaming based on (Column A) if Column (AN contains "Yes"); this is updated on a monthly basis so I would also need to have it not attempt to replace a tab or use the name if it already has created a tab. So my questions are is this task possible? What would be the best way for a newbie to start?

Thanks.

 

[CSmith]

See if this example code I wrote long ago helps any as I don't have any sample info to work with...

    ' Declare variables.
        Dim dDate As Date, dDays As Integer, dDay As Integer, _
            dWkdayStart As Integer, c As Integer, shtName As String, _
            shtRange As String, appName As Application, dMonth As String, _
            dYear As String, m As Integer, y As Integer, LR As Long
       
    ' Initalize Variables
        dDate = Application.Range("Template!A1")
        y = Year(dDate)
        m = Month(dDate)
        dMonth = Format(aDate(y, m, 1), "mm")
        dYear = Format(aDate(y, m, 1), "yy")
        shtName = dYear & dMonth
        dDays = aDate(y, m + 1, 1) - aDate(y, m, 1)
        dWkdayStart = DatePart("w", aDate(y, m, 1))
        LR = Sheets("Template").Range("H" & Rows.Count).End(xlUp).Row
   
    ' Pause screen updates until new sheet is complete
        Application.ScreenUpdating = False

    ' Create or activate DateSheet in Template!A1
        If SheetExists(shtName) Then
            Worksheets(shtName).Activate
        Else
            ActiveWorkbook.Sheets.Add after:=Sheets(Sheets.Count)
            ActiveSheet.Name = shtName
        End If
       
    ' Copy Workers and Template formulas
        shtRange = "Template!B1:D" & LR
        Sheets("Template").Range(shtRange).Copy _
            Destination:=Sheets(shtName).Cells(1, 1)
        shtRange = "Template!E1:J" & LR
        For dDay = 1 To dDays
            c = (dDay - 1) * 6 + 4
            Sheets("Template").Range(shtRange).Copy _
                Destination:=Sheets(shtName).Cells(1, c)
            Sheets(shtName).Cells(1, c).Value = _
            Format(aDate(y, m, dDay), "dd") _
            & Chr(10) & _
            Format(aDate(y, m, dDay), "ddd")
        Next dDay
   
    ' Restart screen updates after finishing!
        Application.ScreenUpdating = True

 

[New_Excel_VBA_User]

Thank you so much for the quick response. I can copy a format and upload if that helps out.

Thanks

 

[New_Excel_VBA_User]

I've parsed down much of the info as the original data file has about 20 columns of data but thought this would give some perspective.

 

[CSmith]

You might use the XL2BB addon (GREEN BUTTON IN THIS EDITOR) to copy your sample data to an easily copyable format. Also, if you explain your needs more that would help also...

 

[New_Excel_VBA_User]

Will do. Thanks. I'm needing to add a tab each time the "Create Tab" column says yes (by copying the template tab and renaming)" I have vlookups in the template tab that pulls off a formula based on the tab name (that is copied from the inventory tab and why i was looking at the template tab being copied and renamed based on column A information).

Thanks again i'll download the addon.

 

[New_Excel_VBA_User]

Agreement_Document Name	Agreeement Effective Date	Agreement Term	Description	Payments							Create Tab
Agreement_8765	4/8/2011	5		$ 24,000.00							Yes
Agreeement_8888	3/1/2020	14
				$ 578.88							No
				$ 651.00							No
				$ 1,208.88							Yes

 

[New_Excel_VBA_User]

I hope I did that correctly; this file will be available on a shared drive so it will be updated by multiple users. When the Column "create tab" = "Yes" I need a copy of the "Template" tab created and to be named the text in Column A. As new data is added I will need the process to repeat, but not replace any existing created tabs; in essence skip that row.

 

[CSmith]

I hope I did that correctly; this file will be available on a shared drive so it will be updated by multiple users. When the Column "create tab" = "Yes" I need a copy of the "Template" tab created and to be named the text in Column A. As new data is added I will need the process to repeat, but not replace any existing created tabs; in essence skip that row.

Assuming Agreement_Document Name is what the Template copy is to be named? How shared?

 

[CSmith]

I hope I did that correctly; this file will be available on a shared drive so it will be updated by multiple users. When the Column "create tab" = "Yes" I need a copy of the "Template" tab created and to be named the text in Column A. As new data is added I will need the process to repeat, but not replace any existing created tabs; in essence skip that row.

WARNING: Being shared may cause problems... otherwise try this out... This acts when the cell create tab gets changed to Yes

This helper code must be in module (View Tab > Macros > View Macros > "type anything in dropdown" > Click create) Then paste this under or in place of the macro you created.

' Coded by Clint Smith
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' tMsgBox Function (Timered Message Box)
' By Clint Smith, clintasm@gmail.com
' Created 04-Sep-2014
' Updated for 64-bit 03-Mar-2020
' This provides an publicly accessible procedure named
' tMsgBox that when invoked instantiates a timered
' message box.  Many constants predefined for easy use.
' There is also a global result variable tMsgBoxResult.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Public Const mbBTN_Ok = vbOKOnly                       'Default
Public Const mbBTN_OkCancel = vbOKCancel
Public Const mbBTN_AbortRetryIgnore = vbAbortRetryIgnore
Public Const mbBTN_YesNoCancel = vbYesNoCancel
Public Const mbBTN_YesNo = vbYesNo
Public Const mbBTN_RetryCancel = vbRetryCancel
Public Const mbBTN_CanceTryagainContinue = &H6
Public Const mbICON_Stop = vbCritical
Public Const mbICON_Question = vbQuestion
Public Const mbICON_Exclaim = vbExclamation
Public Const mbICON_Info = vbInformation
Public Const mbBTN_2ndDefault = vbDefaultButton2
Public Const mbBTN_3rdDefault = vbDefaultButton3
Public Const mbBTN_4rdDefault = vbDefaultButton4
Public Const mbBOX_Modal = vbSystemModal
Public Const mbBTN_AddHelp = vbMsgBoxHelpButton
Public Const mbTXT_RightJustified = vbMsgBoxRight
Public Const mbWIN_Top = &H40000                        'Default

Public Const mbcTimeOut = 32000
Public Const mbcOk = vbOK
Public Const mbcCancel = vbCancel
Public Const mbcAbort = vbAbort
Public Const mbcRetry = vbRetry
Public Const mbcIgnore = vbIgnore
Public Const mbcYes = vbYes
Public Const mbcNo = vbNo
Public Const mbcTryagain = 10
Public Const mbcContinue = 11

Public Const wAccessWin = "OMain"
Public Const wExcelWin = "XLMAIN"
Public Const wWordWin = "OpusApp"

Public tMsgBoxResult As Long

#If VBA7 Then
 
  Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

  Declare PtrSafe Function tMsgBoxA Lib "user32.dll" Alias "MessageBoxTimeoutA" ( _
    ByVal hwnd As Long, _
    ByVal lpText As String, _
    ByVal lpCaption As String, _
    ByVal uType As Long, _
    ByVal wLanguageID As Long, _
    ByVal lngMilliseconds As Long) As Long

#Else

  Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

  Declare Function tMsgBoxA Lib "user32.dll" Alias "MessageBoxTimeoutA" ( _
    ByVal hwnd As Long, _
    ByVal lpText As String, _
    ByVal lpCaption As String, _
    ByVal uType As Long, _
    ByVal wLanguageID As Long, _
    ByVal lngMilliseconds As Long) As Long

#End If

Public Sub tMsgBox( _
    Optional sMessage As String = "Default: (10 sec timeout)" & vbLf & "Coded by Clint Smith", _
    Optional sTitle As String = "Message Box with Timer", _
    Optional iTimer As Integer = 10, _
    Optional hNtype As Long = mbBTN_Ok + mbWIN_Top, _
    Optional hLangID As Long = &H0, _
    Optional wParentType As String = vbNullString, _
    Optional wParentName As String = vbNullString)
   
    tMsgBoxResult = tMsgBoxA(FindWindow(wParentType, wParentName), sMessage, sTitle, hNtype, hLangID, 1000 * iTimer)
End Sub

Public Function SheetExists(strWSName As String) As Boolean
    Dim ws As Worksheet
    SheetExists = False
    On Error Resume Next
    Set ws = Worksheets(strWSName)
    If Not ws Is Nothing Then SheetExists = True
    Set ws = Nothing
End Function

New_Excel_VBA_User.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L
3	Agreement_Document Name	Agreeement Effective Date	Agreement Term	Description	Payments							Create Tab
4	Agreement_8765	4/8/2011	5		24000							No
5	Agreeement_8888	3/1/2020	14
6					578.88							No
7					651							No
Inventory

Cells with Data Validation
Cell	Allow	Criteria
L4:L7	List	Yes,No

Code to attach to sheet with editable data set above...

Private Sub Worksheet_Change(ByVal Target As Range)
  Const createTabCol As String = "L:L"
 
  If (Not Intersect(Target, Range(createTabCol)) Is Nothing) And (Target.Offset(0, 0) = "Yes") Then
    If copySheet(Cells(Target.Row, 1)) Then
      Call tMsgBox("New Sheet Created.", "New Sheet", 3)
    Else
      Call tMsgBox("Sheet Found.", "Sheet Exists", 3)
    End If
  End If
End Sub

Public Function copySheet(newSheetName As String) As Boolean
  ' Create or activate new sheet based on template
  If SheetExists(newSheetName) Then
    Worksheets(newSheetName).Activate
    copySheet = False
  Else
    ThisWorkbook.Sheets("Template").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = newSheetName
    copySheet = True
  End If
   
  ' Restart screen updates after finishing!
  Application.ScreenUpdating = True
End Function