create worksheet out of cell value

**emina002** · 07-24-2012, 04:20 AM

Hi to all hope you could help me with this. I got value on Column A for example 1-10.this already created as worksheet with name "V1~V10" now there are newly added value from 11-14 that I wanted to create a worksheet out of this value with sheet name V11~V14. Macro/VBA will determine this value if the sheet already existing or not,if not it will create a worksheet. Kindly help me I got already a workbook for sample.thanks

**emina002** · 07-24-2012, 04:26 AM

I got already the code kindly help me modify to determine if the value already exist as worksheet name

Sub createSheet()

Dim lastrow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets

With ActiveSheet
    Application.DisplayAlerts = False
   ' For Each ws In ThisWorkbook.Worksheets
    '    If ws.Name <> .Name Then ws.Delete
   ' Next ws
    Application.DisplayAlerts = True
    lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
    LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
    '.Range(.Cells(2, 1), Cells(lastrow, LastCol)).Sort Key1:=Range("D3"), Order1:=xlAscending, _
    '    Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    iStart = 9
    For i = 9 To lastrow
        If ws.Name = "v" & .Range("A" & i).Value Then
        
        i = i + 1
        iStart = iStart + 1
        ElseIf .Range("A" & i).Value <> .Range("A" & i + 1) Then
            iEnd = i
            Sheets.Add after:=Sheets(Sheets.Count)
            Set ws = ActiveSheet
            On Error Resume Next
            ws.Name = "v" & .Range("A" & iStart).Value
            On Error GoTo 0
                  iStart = iEnd + 1
        
        
        End If
         
    Next i
End With
Next ws



End Sub

**jaslake** · 07-24-2012, 05:03 PM

Hi emina002

Assign this code to your Button

Option Explicit
Sub Create_Me()
    Dim LR As Long
    Dim Rng As Range
    Dim cel As Range

    With Sheets("List")
        LR = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Rng = .Range("A2:A" & LR)

        For Each cel In Rng
            If Not WorksheetExists("V" & cel.Value) Then
                Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "V" & cel.Value
            End If
        Next cel
    End With
End Sub

Function WorksheetExists(SheetName As String, _
        Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
    Dim WB As Workbook
    Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
    On Error Resume Next
    WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) > 0)
End Function

Let me know of issues.

**emina002** · 07-25-2012, 09:38 PM

hi @jaslake,its working.thank you

**Cutter** · 07-25-2012, 11:26 PM

@ emina002

Based on your last post it seems that you are satisfied with the solution(s) you've received but you haven't marked your thread as SOLVED. I'll do that for you now but please keep in mind for your future threads that Rule #9 requires you to do that yourself. If your problem has not been solved you can use Thread Tools (located above your first post) and choose "Mark this thread as unsolved".
Thanks.