CODEWITHSUNDEEP
excelvbarangeworksheet
Progolfer79
Progolfer79

Reputation: 29

Insert Worksheet Alphabetically Within A Defined Range of Worksheets

I have a workbook with different sections of worksheets defined with "Divider" worksheets. One section example as such :

When a new company is entered into the 'Master' sheet, the 'Company Template' sheet is copied, inserted after the 'DIV - OVERVIEW' divider sheet and before the 'DIV - NEWS' divider sheet, and the worksheet is renamed using the entry text. The following code is used for the process :

Dim TEMPOverview As Worksheet

wsTEMPOverview.Copy After:=.Sheets("DIV - OVERVIEW")
ActiveSheet.Name = CStr(Nm.Text)

I would like is to have the new sheet placed alphabetically within a specified range of sheets. For instance : 'Company B' is placed between 'Company A' and 'Company C' within the 'DIV - OVERVIEW':'DIV - NEWS' range of sheets. I suppose the starting issue is how to define the range of sheets using the divider sheets. Then I would use a For loop to place the copied sheet alphabetically within the range like so :

Dim o
    For o = 1 To trackingWB.Sheets.Count
        If trackingWB.Sheets(o).Name >= companyName.Text Then
            Exit For
        End If
    Next o
    wsTEMPOverview.Copy before:=trackingWB.Sheets(o)
    ActiveSheet.Name = CStr(Nm.Text)

How would I go about this?

Upvotes: 0

Views: 31

Answers (1)

Tim Williams
Tim Williams

Reputation: 166146

Something like this would work:

Sub sheetTest()
    CreateSheetFromTemplate "CompanyB"
    CreateSheetFromTemplate "CompanyZZ"
    CreateSheetFromTemplate "CompanyH"
End Sub


Sub CreateSheetFromTemplate(companyName As String)
    Dim indxOv As Long, indxNews As Long, wb As Workbook, n As Long, pos As Long
    Dim wsTEMPOverview As Worksheet
    
    Set wb = ThisWorkbook
    indxOv = wb.Worksheets("DIV - OVERVIEW").Index 'positions of the bounding sheets
    indxNews = wb.Worksheets("DIV - NEWS").Index
    Set wsTEMPOverview = wb.Worksheets("template")
    
    For n = indxOv + 1 To indxNews - 1
        If wb.Worksheets(n).Name > companyName Then 'compare names
            pos = n  'insert before sheet n
            Exit For 'done schecking
        End If
    Next n
    If pos = 0 Then pos = indxNews 'new name comes after all existing sheets
    
    wsTEMPOverview.Copy before:=wb.Sheets(pos) 'copy and rename
    ActiveSheet.Name = companyName
    
End Sub

Might want to add a check that the name doesn't already exist.

Upvotes: 1

Related Questions