Excel VBA/Macro

Closed
rpluss - Apr 21, 2016 at 05:55 PM
vcoolio Posts 1404 Registration date Thursday July 24, 2014 Status Moderator Last seen September 15, 2023 - Apr 23, 2016 at 01:50 AM
Hello,



Need help in creating a Macro to do the following

I have a set of formulas on a worksheet called “Adam”. Cell A2 of worksheet “Adam” displays number 1. There is a range of names stored in a column on a sheet called “Names” like Blake, Charlie, David in the same workbook. I want to create a macro to do the following:
1. Create copy of worksheet Adam and rename them as Blake
2. Then on cell A2 of worksheet “Blake” display number 2
3. Create copy of previous worksheet(Blake or Adam) and rename it to Charlie
4. On cell A2 of worksheet ”Charlie” display number 3
5. Create copy of previous worksheet and rename it to David
6. On cell A2 of worksheet “David” display number 4
And so on..You get the idea..continue until the list of names ends.

I tried recording Macro to do this but no luck. I am a beginner to VBA and need to figure this one out.

Please let me know.

Thanks,
Related:

1 response

vcoolio Posts 1404 Registration date Thursday July 24, 2014 Status Moderator Last seen September 15, 2023 259
Apr 23, 2016 at 01:50 AM
Hello Rpluss,

The following code should do the task for you:-


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Application.ScreenUpdating = False

   Dim wsNames As Worksheet
   Dim wsNew As Worksheet
   If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
   If Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then Exit Sub
   
On Error Resume Next

Set wsNew = Sheets(Target.Value)

   If Not wsNew Is Nothing Then
   MsgBox "A sheet for A/c No. " & Target.Value & " already exists. No new sheet will be added.", vbExclamation
   Exit Sub
End If

Set wsNames = ActiveSheet
    Sheets("Adam").Copy After:=Sheets(Sheets.Count)
With Sheets(Sheets.Count)
   .Name = Target.Value
End With

For Each wsNew In Worksheets
       If wsNew.Name <> "Names" Then
       wsNew.Range("A2").Value = wsNew.Previous.Range("A2").Value + 1
       End If
Next wsNew

Sheets("Names").Select
Application.ScreenUpdating = True

End Sub



Following is the link to my test work book for you to peruse:-
https://www.dropbox.com/s/qbv2whii24m8sd6/Rpluss%28Auto%20create%20sheets%20and%20name%20them%29%2C2.xlsm?dl=0

The code is a Worksheet_BeforeDoubleClick event so double click on any name in Column A in the "Names" sheet and a new sheet will be created in that name. The code will also:-

- Add the consecutive numbers in cell A2 of each new sheet.
- Transfer any formulae to the new sheet.

If you inadvertently try and create a sheet with the same name, a message box will pop up warning you that a sheet with that name already exists and no new sheet will thus be created.

For the code to execute correctly, the first sheet ("Names") in the work book, needs to be the left-most sheet followed by "Adam" with the value 1 in cell A2 (you will need to manually create sheet "Adam").

The sheet "Adam" is now, in effect, the template sheet from which all the new ones are created.

The code will need to go into the work sheet module so, to implement the code, right click on the "Names" sheet tab and select "view code" from the menu that appears. In the big white field that appears, paste the above code.

Test the code in a copy of your work book first.

I hope that this helps.

Cheerio,
vcoolio.
0