VBA: Add Sheet and Name it

gripper

Board Regular
Joined
Oct 29, 2002
Messages
143
Below is an existing macro that automatically imports data from a text file onto a new sheet and then runs a sub to format and then repeats for a second sheet before ending the sub.

One feature I would like to add to this is a way to automatically name the 2 different sheets it creates based on the following:

First Sheet = "Client 1" & Today's Date in format (Month and Day)
Second Sheet = "Associate" & Today's Date in format (Month and Day)

Also I have concern about certain days I have to run this more than once which may add a duplicate name. So if there is a way of handling this

Any help would be greatly appreciated.

Thank you.

Sub Add_Sheets()
'
' addsheets Macro
'
'
Sheets.Add After:=ActiveSheet
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\production\Desktop\Orders\C-1.txt", _
Destination:=Range("$A$1"))
'.CommandType = 0
.Name = "1 with smi"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Application.Run "'Inventorysys.xlsm'!Order_Format"


Sheets.Add After:=ActiveSheet
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\production\Desktop\Orders\Associate_Area.txt", _
:=Range("$A$1"))
'.CommandType = 0
.Name = "2.25"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Application.Run "'Inventorysys.xlsm'!Order_Format"
End Sub
 

Some videos you may like

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
19,237
Office Version
  1. 2013
Platform
  1. Windows
Like this

Code:
Sub Add_Sheets()
Dim sh As Worksheet, flg As Boolean
For Each sh In Worksheets
If sh.Name Like "Client 1*" Then flg = True: Exit For
Next
If flg = True Then Sheets.Add.Name = "Client 1" & Date
End If
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\production\Desktop\Orders\C-1.txt", _
Destination:=Range("$A$1"))
 

gripper

Board Regular
Joined
Oct 29, 2002
Messages
143
Hi Michael M.

Thank you for the quick response. I have added this code but I seem to running into the following error "End if without Block If" when executing. I did some research and could not figure out the issue. Here is the snap shot of the first few lines of code as added into my VBA Code.

Thank you

Code:
Dim sh As Worksheet, flg As Boolean
    For Each sh In Worksheets
    If sh.Name Like "Client 1*" Then flg = True: Exit For
    Next
    If flg = True Then Sheets.Add.Name = "Client 1" & Date
    End If

    
    With ActiveSheet.QueryTables.Add(Connection:= _
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
Try with the following

Change data in red with your information:

If the sheet already exists then create the sheet with the suffix 1, if the sheet 1 already exists then create the sheet 2 and so on
eg. "Client 1 mar15", "Client 1 mar15 1", "Client 1 mar15 2", etc.

Code:
Sub Add_Sheets()
    '
    ' addsheets Macro
    '
    '
    Dim wpath As String
    Dim sName As Variant, txts As Variant, qName As Variant
    Dim i As Long, n As Long, s As Worksheet, exists As Boolean
    Dim newName As String
    
    Application.ScreenUpdating = False
    
    wpath = "[COLOR=#ff0000]C:\Users\production\Desktop\Orders\[/COLOR]"
    
    sName = Array("[COLOR=#ff0000]Client 1[/COLOR]", "[COLOR=#ff0000]Associate[/COLOR]")                                     'sheets name
    txts = Array(wpath & "[COLOR=#ff0000]C-1.txt[/COLOR]", wpath & "[COLOR=#ff0000]Associate_Area.txt[/COLOR]")   'txt name
    qName = Array("[COLOR=#ff0000]1 with smi[/COLOR]", "[COLOR=#ff0000]2.25[/COLOR]")                                       'query name
    
    For i = 0 To UBound(sName)
    
        n = 0
        exists = True
        newName = sName(i) & " " & Format(Date, "mmmdd")
        Do While exists = True
            exists = False
            For Each s In Sheets
                If LCase(s.Name) = LCase(newName) Then
                    exists = True
                    n = n + 1
                    newName = sName(i) & " " & Format(Date, "mmmdd") & " " & n
                    Exit For
                End If
            Next
        Loop

        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = newName
        
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & txts(i) & "", Destination:=Range("$A$1"))
            '.CommandType = 0
            .Name = qName(i)
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
            1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        Application.Run "'Inventorysys.xlsm'!Order_Format"
    Next
    Application.ScreenUpdating = True
    
    MsgBox "End"
End Sub
 

gripper

Board Regular
Joined
Oct 29, 2002
Messages
143
Dante,

That code worked perfectly. It ran like clockwork. Also I tested the duplicate renaming of the sheets and that worked great as well. That is a perfect solutions and I thank you very much sir for your assistance. You are a fantastic coder.

Thank you again
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. I appreciate your kind comments.
 

Watch MrExcel Video

Forum statistics

Threads
1,108,627
Messages
5,523,985
Members
409,551
Latest member
WillCaton

This Week's Hot Topics

Top