Solved: create worksheets from column values

[white_flag]

Hello

I have a column with some names ex "Data-1, Data-old, Data-2, Data-1 ..etc" from this column I like to create to create worksheets in another workbook. If worksheets it is allready created to skip this. I try to puted likle this:


Sub NameSheets()
Dim wb As Workbook
Dim name_sh As Range

Set wb = Workbooks.Add
Application.DisplayAlerts = False
wb.SaveAs FileName:="new_file"

name_sh = ThisWorkbook.Sheets("Calculation").Range("B14", Cells(LastRowNume, "B").Address).Values

If SheetExists(sheetname, ThisWorkbook.Name) Then
'turn off alert to user before auto deleting a sheet so the function is not interrupted
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(nume_sh).Delete
Application.DisplayAlerts = True
End If


wb.Activate
Application.Sheets.Add
ActiveSheet.Name = nume_sh



End Sub

Function SheetExists(sname, Optional wbName As Variant) As Boolean
' check a worksheet exists in the active workbook
' or in a passed in optional workbook
Dim X As Object

On Error Resume Next
If IsMissing(wbName) Then
Set X = ActiveWorkbook.Sheets(sname)
ElseIf WorkbookIsOpen(wbName) Then
Set X = Workbooks(wbName).Sheets(sname)
Else
SheetExists = False
Exit Function
End If

If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function

Function WorkbookIsOpen(wbName) As Boolean
' check to see if a workbook is actually open
Dim X As Workbook
On Error Resume Next
Set X = Workbooks(wbName)
If Err = 0 Then WorkbookIsOpen = True _
Else WorkbookIsOpen = False
End Function



I have error 438. How Can I define this:

name_sh = ThisWorkbook.Sheets("Calculation").Range("B14", Cells(LastRowNume, "B").Address).Values

[Bob Phillips]

Not looked at all the code, just the one you highlight.



name_sh = ThisWorkbook.Sheets("Calculation").Range("B14").Offset(LastRowNum-2).Value

[white_flag]

like this result:
ThisWorkbook.Sheets("Calculation").Range("B14").Offset(LastRowNum-2).Value

name_sh = <empty>

[mancubus]

hi.

Dim name_sh As Range

so...


LastRowNume = Cells(Rows.Count, "B").End(xlUp).Row
Set name_sh = Sheets("Calculation").Range("B14:B" & LastRowNume)

[white_flag]

error 9
Subscript out of range

Set name_sh = Sheets("Calculation").Range("B14:B" & LastRowNume)

[mancubus]

what i posted is something to play with.

perhaps LastRowNume returns a row number which is less than 14...

[Bob Phillips]

Lastrow looks the most obvious suspect. When you get the error, look at its value.

[white_flag]

I solved like this:


Dim Itm As Long

MyArr = Application.WorksheetFunction.Transpose(ThisWorkbook.Sheets("Calculation").Range("B13", Cells(LastRowNume, 2).Address).SpecialCells(xlCellTypeConstants))
For Itm = 1 To UBound(MyArr)
If Not Evaluate("=ISREF('" & MyArr(Itm) & "'!A1)") Then 'create sheet if needed
ThisWorkbook.Sheets(MyArr(Itm)).Copy After:=wb.Sheets("Sheet1")
'wb.Sheets(MyArr(Itm)).Columns.AutoFit
Else 'clear sheet if it exists
Sheets(MyArr(Itm)).Move After:=Sheets(Sheets.Count)
Sheets(MyArr(Itm)).Cells.Clear
End If

Next Itm