*VBA Code Help* Populate Sheet based on Cell value

[cparks]

Ok folks, I have a bit of a problem.

What I want is when a cell is populated, I want to immediately create a Sheet. That sheet's name will be based on the text inside that cell.

ALSO, I want it to create a hyperlink to that sheet.

My Current Sheet is "Crew" and the starting cell for this is in D5.

Below is what I have already and I placed it in my "Crew" sheet. The problem I'm having is once a cell is populated, I have to Run the macro for it to work. And sometimes, I'll get an error message and a sheet would be populated, but it would be "Sheet1", "Sheet2",....not what is currently in that cell.

Any help will be greatly appreciated! Thanks much!

Private Sub CreateSheetsFromAListTEST()

Dim MyCell As Range, MyRange As Range

Set MyRange = Range(Sheets("Crew").[d5], Sheets("Crew").Cells(Rows.Count, "D").End(xlUp))

For Each MyCell In MyRange
    If Len(MyCell.Text) > 0 Then
        Sheets.Add after:=Sheets(Sheets.Count) 'creates a new workbook
        Sheets(Sheets.Count).Name = MyCell.Value 'renames the new workbook
    End If
Next MyCell
End Sub

__________________________________________________________________

Mod edit : thread moved to appropriate forum !​

 

[charlesdh]

Hi,

See if this helps.

Private Sub CreateSheetsFromAListTEST()

Dim MyCell As Range, MyRange As Range

Set MyRange = Range(Sheets("Crew").[d5], Sheets("Crew").Cells(Rows.Count, "D").End(xlUp))

For Each MyCell In MyRange
    If Len(MyCell.Text) > 0 Then
    Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyCell.Value

       ' Sheets.Add After:=Sheets(Sheets.Count) 'creates a new workbook
       'Sheets(Sheets.Count).Name = MyCell.Value 'renames the new workbook
   End If
Next MyCell
End Sub

Oops' forgot the remark a line of the code

 

[cparks]

Hi,

See if this helps.

Private Sub CreateSheetsFromAListTEST()

Dim MyCell As Range, MyRange As Range

Set MyRange = Range(Sheets("Crew").[d5], Sheets("Crew").Cells(Rows.Count, "D").End(xlUp))

For Each MyCell In MyRange
    If Len(MyCell.Text) > 0 Then
    Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyCell.Value

       ' Sheets.Add After:=Sheets(Sheets.Count) 'creates a new workbook
       'Sheets(Sheets.Count).Name = MyCell.Value 'renames the new workbook
   End If
Next MyCell
End Sub

Oops' forgot the remark a line of the code

It gives me an "Application/Object defined error" whenever I try running the code. I look at if it does anything and basically does the same, it'll make a sheet for the first cell, but then after wards it makes a sheet but not what the cell has. Somewhere it's not liking the cells after the first

 

[Chihiro]

So what's contained in the cells referenced? Upload sample workbook.

 

[charlesdh]

HI,

I modified your code. I tested and it worked for me.

Private Sub CreateSheetsFromAListTEST()

Dim i As Long
Dim lrow As Long
lrow = Sheets("Crew").Range("D5").End(xlUp).Row
For i = 1 To lrow
    Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = Sheets("Crew").Cells(i, 4).Text
Next i
End Sub

Charles

 

[cparks]

So what's contained in the cells referenced? Upload sample workbook.

Yes, this will possibly be better.

The sample workbook is a skeleton of what I exactly have, but has the necessary cells needed.

Red cells have formulas; the yellow field is where I would like to have the populated sheets named and hyperlinked.

Again, thanks for the help.

 

[cparks]

Also, I have allowed a 30 cell max for each field (dont want more than 30 crew members). If that helps....youll see a blacked out row towards the bottom

 

[Chihiro]

Should sheets be created with Safe Name?

This is fairly straight forward, but it is recommended you add error traps.
Also, hyperlinks should be added to cells that's not populated with formula (or just populate entire Col D via code).

I'm going into meeting now. But will look at it more in detail this evening.

 

[cparks]

Should sheets be created with Safe Name?

This is fairly straight forward, but it is recommended you add error traps.
Also, hyperlinks should be added to cells that's not populated with formula (or just populate entire Col D via code).

I'm going into meeting now. But will look at it more in detail this evening.

Actually yes, the Safe Name range (E5:E34) should be the range where new sheets are populated. My mistake.

So if we can get E5:E34 to be the hyperlink range and still keep the integrity of the formula that would be great.

What would you recommend for an error trap? I might know what you're talking about but I want to be sure.

What would be the possibility of adding for every new sheet, a hyperlink to a specific tab (i.e. Management) in A1?

Me and another guy will be the only ones using this, so the error factor is very limited.

 

[Chihiro]

By Error trap, I meant checking if the worksheet name already exists. Try following code.

Sample worksheet attached (note that D column is now filled entirely by VBA)

Sub Test()
Dim lRow As Integer, i As Integer
Dim ws As Worksheet
Dim cel As Range
i = 0
lRow = Worksheets("Crew").Cells(Rows.Count, 2).End(xlUp).Row


For Each cel In Worksheets("Crew").Range("E5:E" & lRow)
    If shtNameChk(cel.Value) = False Then
    Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    ws.Name = cel.Value
    cel.Offset(0, -1).Hyperlinks.Add Anchor:=cel.Offset(0, -1), Address:="", _
        SubAddress:=ws.Name & "!A1", TextToDisplay:=cel.Offset(0, -2).Value & ", " & cel.Offset(0, -3).Value
    i = i + 1
    End If
Next

Worksheets("Crew").Select
MsgBox i & " new sheets and hyperlinks added"
End Sub

Public Function shtNameChk(shName As String) As Boolean
Dim sht As Worksheet
Dim shtNames As String

For Each sht In ThisWorkbook.Sheets
    shtNames = shtNames & sht.Name
Next

If InStr(1, shtNames, shName) > 0 Then
    shtNameChk = True
Else
    shtNameChk = False
End If
End Function

 

[cparks]

By Error trap, I meant checking if the worksheet name already exists. Try following code.

Sample worksheet attached (note that D column is now filled entirely by VBA)

Sub Test()
Dim lRow As Integer, i As Integer
Dim ws As Worksheet
Dim cel As Range
i = 0
lRow = Worksheets("Crew").Cells(Rows.Count, 2).End(xlUp).Row


For Each cel In Worksheets("Crew").Range("E5:E" & lRow)
    If shtNameChk(cel.Value) = False Then
    Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    ws.Name = cel.Value
    cel.Offset(0, -1).Hyperlinks.Add Anchor:=cel.Offset(0, -1), Address:="", _
        SubAddress:=ws.Name & "!A1", TextToDisplay:=cel.Offset(0, -2).Value & ", " & cel.Offset(0, -3).Value
    i = i + 1
    End If
Next

Worksheets("Crew").Select
MsgBox i & " new sheets and hyperlinks added"
End Sub

Public Function shtNameChk(shName As String) As Boolean
Dim sht As Worksheet
Dim shtNames As String

For Each sht In ThisWorkbook.Sheets
    shtNames = shtNames & sht.Name
Next

If InStr(1, shtNames, shName) > 0 Then
    shtNameChk = True
Else
    shtNameChk = False
End If
End Function

Works great! The only thing it needs to do (or I need to figure out a way) is after I enter in my data, for it to update it either automatically after the Enter or Tab key is pressed, or set up a button to add record(s).

As It stands now, after I enter my data, I have to go to the VBA page, click Run. Then after I press "ok" on the message box, it takes me back to the VBA page.

 

[Chihiro]

Go to Developer tab and click on "Macros"

Find the Sub in Macro list and click on "Options".

You can assign shortcut key there.

Alternately you can call the sub from worksheet module using Change event on manually updated cells.