Multiple looping VBA questions

[NBigley]

I have a couple of questions and as much searching as I have done, I am not able to find exactly what I need, I am hoping someone can help:

I have a list of names on the first tab labeled "INTERNAL USE ONLY" The names are listed by last name starting at A4, first name in B4 and I also have last,first name listed in D4. There could be 10 names or 100 and the user will enter these. Then I have another tab labeled "FACULTY" where I have multiple tables set up for data to be entered. (I wasn't able to paste my example so I made a similar table below)

	A	B	C	D
1
2
3	Last Name	First Name	Rank	Last, First
4	Smith	John	TaP	Smith, John
5	Johnson	Alice	TAP	Johnson, Alice
6	Moore	Kevin	AP	Moore, Kevin

<tbody>
</tbody>

What I need is a code to take the first (last) name from A4 and create a new tab identical to the FACULTY tab, name the tab as the last name, and then take the last,first name (D4) and enter it into cell B5 on the newly created tab.

I already have the code to create the new tabs and rename them. What I can't figure out is how to also copy the first,last name column and paste it into the new worksheet into cell B5.

Sub Copysheet()


Application.ScreenUpdating = False


Dim MyCell As Range, MyRange As Range

Set MyRange = Sheets("INTERNAL USE ONLY").Range("A4")
Set MyRange = Range(MyRange, MyRange.End(xlDown))


For Each MyCell In MyRange
Sheets("Faculty").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = MyCell.Value
Next MyCell
Application.ScreenUpdating = True

End Sub


Finally, I have a code that renames each table in the worksheet so that each table is unique and I can link to them in a summary page. Currently, I have to go to each page and run the macro, so I would love to add this onto the looping macro so I only have to run once. Is this possible?

I could paste the code, but it is really long because I had to copy/paste multiple times and I am pretty new to VBA so I am sure it is more clunky than it needs to be. Let me know if you need to see that code as well.

Thanks for any help you are able to give! And please let me know if something is not clear.


****** id="cke_pastebin" style="position: absolute; top: 130.4px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">

A

B

C

<tbody>
</tbody>

</body>

 

[mumps]

Place this line of code:

Sheets(MyCell.Value).Range("B5") = Sheets("Faculty").Cells(MyCell.Row, 4)

below this line:

Sheets(Sheets.Count).Name = MyCell.Value

 

[NBigley]

Place this line of code:

Sheets(MyCell.Value).Range("B5") = Sheets("Faculty").Cells(MyCell.Row, 4)

below this line:

Sheets(Sheets.Count).Name = MyCell.Value

Hmmm that didn't seem to work. I can't figure out what/if that did anything...

 

[mumps]

It is always easier to help and test possible solutions if we could work with your actual file. Perhaps you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells and worksheets. If the workbook contains confidential information, you could replace it with generic data.

 

[NBigley]

It is always easier to help and test possible solutions if we could work with your actual file. Perhaps you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells and worksheets. If the workbook contains confidential information, you could replace it with generic data.

Thank you for the suggestion!

Below is a link to my report:

https://www.dropbox.com/s/ma6xfh7gdonmvo2/FDR template test NMB.xlsm?dl=0

I have a list of name on the "INTERNAL TAB ONLY" and I need to create a new "Faculty" worksheet for each name on the list and put their names at the top of the page. I hope this makes sense!

 

[mumps]

Try:

Sub CreateSheets()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("INTERNAL USE ONLY").Range("A" & Rows.Count).End(xlUp).Row
    Dim lName As Range
    For Each lName In Sheets("INTERNAL USE ONLY").Range("A4:A" & LastRow)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(lName.Value)
        On Error GoTo 0
        If ws Is Nothing Then
            Sheets("Faculty").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = lName.Value
            Range("B5") = Sheets("INTERNAL USE ONLY").Cells(lName.Row, 4)
        End If
    Next lName
    Application.ScreenUpdating = True
End Sub

 

[NBigley]

That is perfect, thank you!

 

[mumps]

You are very welcome.