VBA: Add Sheet and Name it

gripper

Board Regular
Joined
Oct 29, 2002
Messages
176
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
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
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"))
 
Upvote 0
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:= _
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
I'm glad to help you. I appreciate your kind comments.
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,557
Latest member
richa mishra

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top