Rename Created Worksheet based on next number

G

grabrail

Board Regular
Joined
Sep 6, 2010
Messages
128
Office Version
  1. 365
Platform
  1. Windows
Hi

I have 2 problems I need to solve. I have created a template worksheet which is used for reporting on vehicles. When our inspector goes to site he does not know how many vehicles there will be to check, this requires one worksheet per vehicle, the date from each worksheet is then collated in a summary page. I have my template all working and data being imported to the new summary tab.

What I want to achieve is

1) have a button on the worksheet, that allows you to add a new worksheet by duplicating the template. (I have done this and it works using the following code)

VBA Code: 
Private Sub CommandButton1_Click()
    Dim i As Byte
    Sheets("DPU Report Template").Copy after:=Sheets("DPU Report Template")
 End Sub

However I want to name the newly created sheet a specific name, so the first time you click the button the new worksheet is called "DPU Report 1", if I click the button again to create a second worksheet I want it to be name "DPU Worksheet 2" and so on. So I think I need my code to check for the last DPU Report worksheet number and append 1 to it.


The second problem I have, is I have a button on the summary sheet that when you click it goes and gathers all of the data from the template sheet and pastes it into the correct columns on the summary sheet. I nede this button to be able to a) check how many DPU Reports worksheets have been created, and then gather the data from each one of them and add it to the summary tab. Each report worksheet can equal multiple rows on the summary tab.


This is the code of my button at the moment, which just references the report template worksheet. I need the references to the template sheet to reference each of the created worksheets when the reporting is done

Code: 
Public Sub CommandButton1_Click()

Dim tdate As Date
Dim iDate As String
Dim time As String
Dim operator As String
Dim depot As String
Dim inspector As String
Dim driver As String
Dim vType As String
Dim reg As String
Dim meansINSP As String
Dim odometer As String
Dim oLicence As String
Dim ADR As String
Dim VTG As String
Dim tachoType As String
Dim preUse As String
Dim CPC As String
Dim printOut As String
Dim spare As String
Dim cleanliness As String
Dim understand As String
Dim OCRS As String

iDate = Worksheets("DPU Report Template").Range("C2").Value
time = Worksheets("DPU Report Template").Range("H2").Value
operator = Worksheets("DPU Report Template").Range("c3").Value
depot = Worksheets("DPU Report Template").Range("C4").Value
inspector = Worksheets("DPU Report Template").Range("C8").Value
driver = Worksheets("DPU Report Template").Range("C5").Value
vType = Worksheets("DPU Report Template").Range("H5").Value
reg = Worksheets("DPU Report Template").Range("C6").Value
meansINSP = "Walk Around Check"
odometer = Worksheets("DPU Report Template").Range("H6").Value
oLicence = Worksheets("DPU Report Template").Range("H7").Value
ADR = Worksheets("DPU Report Template").Range("H8").Value
VTG = Worksheets("DPU Report Template").Range("C10").Value
tachoType = Worksheets("DPU Report Template").Range("H9").Value
preUse = Worksheets("DPU Report Template").Range("H11").Value
CPC = Worksheets("DPU Report Template").Range("H12").Value
printOut = Worksheets("DPU Report Template").Range("H13").Value
spare = Worksheets("DPU Report Template").Range("I14").Value
cleanliness = Worksheets("DPU Report Template").Range("I15").Value
understand = Worksheets("DPU Report Template").Range("I16").Value

Sheets("Data Extract").Range("A3:BB500").Clear

'check how may cells have data
Worksheets("DPU Report Template").Select
Worksheets("DPU Report Template").Range("A37").Select

Worksheets("DPU Report Template").Range(Selection, Selection.End(xlDown)).Select
Dim numEntry As Integer
Dim Rng As Integer
numEntry = Selection.Count
If numEntry >= 12 Then 'if there is only one item, the above selection.down grabs the next cell with data, causing an error
    numEntry = 1
End If
Rng = 36 + numEntry



If Worksheets("DPU Report Template").Range("J34").Value = "Yes" Then

Sheets("Data Extract").Range("A3").Value = iDate
Sheets("Data Extract").Range("B3").Value = time
Sheets("Data Extract").Range("C3").Value = operator
Sheets("Data Extract").Range("D3").Value = depot
Sheets("Data Extract").Range("E3").Value = inspector
Sheets("Data Extract").Range("F3").Value = driver
Sheets("Data Extract").Range("G3").Value = vType
Sheets("Data Extract").Range("H3").Value = reg
Sheets("Data Extract").Range("I3").Value = meansINSP
Sheets("Data Extract").Range("J3").Value = odometer
Sheets("Data Extract").Range("K3").Value = oLicence
Sheets("Data Extract").Range("L3").Value = ADR
Sheets("Data Extract").Range("M3").Value = VTG
Sheets("Data Extract").Range("N3").Value = tachoType
Sheets("Data Extract").Range("O3").Value = preUse
Sheets("Data Extract").Range("P3").Value = CPC
Sheets("Data Extract").Range("Q3").Value = printOut
Sheets("Data Extract").Range("R3").Value = spare
Sheets("Data Extract").Range("S3").Value = cleanliness
Sheets("Data Extract").Range("T3").Value = understand
Sheets("Data Extract").Range("W3").Value = "No Additional Defects Found"
'Sheets("Data Extract").Range("A3").Select

Else

'copy the unique data to the SUMMARY sheet
    'IM
    Worksheets("DPU Report Template").Range("B37:B" & Rng).Copy
    Worksheets("Data Extract").Range("U3:U" & (numEntry + 2)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    'SERVICABLE
    Worksheets("DPU Report Template").Range("G37:G" & Rng).Copy
    Sheets("Data Extract").Range("V3:V" & (numEntry + 2)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    'DEFECT TEXT
    Worksheets("DPU Report Template").Range("C37:C" & Rng).Copy
    Sheets("Data Extract").Range("W3:W" & (numEntry + 2)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    'OCRS
    Worksheets("DPU Report Template").Range("H37:H" & Rng).Copy
    Sheets("Data Extract").Range("X3:X" & (numEntry + 2)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False



Sheets("Data Extract").Range("A3").Value = iDate
Sheets("Data Extract").Range("B3").Value = time
Sheets("Data Extract").Range("C3").Value = operator
Sheets("Data Extract").Range("D3").Value = depot
Sheets("Data Extract").Range("E3").Value = inspector
Sheets("Data Extract").Range("F3").Value = driver
Sheets("Data Extract").Range("G3").Value = vType
Sheets("Data Extract").Range("H3").Value = reg
Sheets("Data Extract").Range("I3").Value = meansINSP
Sheets("Data Extract").Range("J3").Value = odometer
Sheets("Data Extract").Range("K3").Value = oLicence
Sheets("Data Extract").Range("L3").Value = ADR
Sheets("Data Extract").Range("M3").Value = VTG
Sheets("Data Extract").Range("N3").Value = tachoType
Sheets("Data Extract").Range("O3").Value = preUse
Sheets("Data Extract").Range("P3").Value = CPC
Sheets("Data Extract").Range("Q3").Value = printOut
Sheets("Data Extract").Range("R3").Value = spare
Sheets("Data Extract").Range("S3").Value = cleanliness
Sheets("Data Extract").Range("T3").Value = understand



'copy this range to the sheet
Sheets("Data Extract").Select
Sheets("Data Extract").Range("A3:T3").Copy
Sheets("Data Extract").Range("A3:T" & (numEntry + 2)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' +1I as it starts at row 2, 1 range = only row2


tdate = Date
'Sheets("Data Extract").Range("E1").Value = tdate
Sheets("Data Extract").Range("D1").Value = "Data Imported on " & tdate
Application.CutCopyMode = False
Sheets("Data Extract").Range("A1").Select

With Worksheets("Data Extract").Range("A3:A100")
    .NumberFormat = "mm/dd/yyyy"
End With

With Worksheets("Data Extract").Range("b3:b100")
    .NumberFormat = "hh:mm"
End With



End If

End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
Hi grabrail,

regarding the first question: you could store the value in a name in the workbook and augment the value with each copy (Name could be set to be invisible, with the code below it will be displayed in the Formular Manager). This will generate a consecutive number as long as the counter is not altered/reset:

VBA Code: 
Private Sub CommandButton1_Click()
  Dim lngNew            As Long
  Dim objVersName       As Name
  Dim strValue          As String
  
  Const cstrVersion     As String = "DPU_Report"
  Const cstrEqual       As String = "="
  
  On Error Resume Next
  Set objVersName = ThisWorkbook.Names(cstrVersion)
  If Err.Number > 0 Then
    strValue = 0
    Names.Add cstrVersion, 1
  Else
    strValue = Replace(Names(cstrVersion).RefersTo, cstrEqual, Empty)
    Names(cstrVersion).RefersTo = cstrEqual & CLng(strValue) + 1
  End If
  Err.Clear
  On Error GoTo 0
  Set objVersName = Nothing
  
  lngNew = CLng(strValue) + 1
  Sheets("DPU Report Template").Copy after:=Sheets("DPU Report Template")
  ActiveSheet.Name = "DPU Report " & Format(Date, "yymmdd_") & lngNew

End Sub

Regarding your second question: where will be worksheets be located, in the workbook with the template or in another workbook? If the latter: where are these workbooks located, do you have an extra directory for those still to import and another one for those already imported (moving files can be done by vba)? What is the criteria to distinguish the imports from the sheets (name of worksheet, serial number for the data imported lines)? Instead of using the long way to have variables for each single data I would prefer to utilze an array for the cells to collect and add the data to the first free row in the summary sheet.

I have problems to understand as you state there may be more than one set of data on the protocol, can you tell at which row the first set of data starts, how many rows it spans and if there is gap between the single sets in rows. Do you want to overwrite the data in the summary sheet or have one sheet for each import? I see the code but that is only for one set of data so I think it would be helpfull to get that information.

Ciao,
Holger
 
Upvote 0
HaHoBe said:
Hi grabrail,

regarding the first question: you could store the value in a name in the workbook and augment the value with each copy (Name could be set to be invisible, with the code below it will be displayed in the Formular Manager). This will generate a consecutive number as long as the counter is not altered/reset:

VBA Code: 
Private Sub CommandButton1_Click()
  Dim lngNew            As Long
  Dim objVersName       As Name
  Dim strValue          As String
 
  Const cstrVersion     As String = "DPU_Report"
  Const cstrEqual       As String = "="
 
  On Error Resume Next
  Set objVersName = ThisWorkbook.Names(cstrVersion)
  If Err.Number > 0 Then
    strValue = 0
    Names.Add cstrVersion, 1
  Else
    strValue = Replace(Names(cstrVersion).RefersTo, cstrEqual, Empty)
    Names(cstrVersion).RefersTo = cstrEqual & CLng(strValue) + 1
  End If
  Err.Clear
  On Error GoTo 0
  Set objVersName = Nothing
 
  lngNew = CLng(strValue) + 1
  Sheets("DPU Report Template").Copy after:=Sheets("DPU Report Template")
  ActiveSheet.Name = "DPU Report " & Format(Date, "yymmdd_") & lngNew

End Sub

Regarding your second question: where will be worksheets be located, in the workbook with the template or in another workbook? If the latter: where are these workbooks located, do you have an extra directory for those still to import and another one for those already imported (moving files can be done by vba)? What is the criteria to distinguish the imports from the sheets (name of worksheet, serial number for the data imported lines)? Instead of using the long way to have variables for each single data I would prefer to utilze an array for the cells to collect and add the data to the first free row in the summary sheet.

I have problems to understand as you state there may be more than one set of data on the protocol, can you tell at which row the first set of data starts, how many rows it spans and if there is gap between the single sets in rows. Do you want to overwrite the data in the summary sheet or have one sheet for each import? I see the code but that is only for one set of data so I think it would be helpfull to get that information.

Ciao,
Holger
Click to expand...
Hi, Thanks for the answer, but I went a different route.

I decided to create 20 sheets from the template worksheet, and named them manually.

I then used a for loop to gather the data from each sheet and populate my summary sheet.

This is working for me and the client is happy.
 
Upvote 0
Hi grabrail,

glad to hear you found a solution and thanks for letting us know.

Ciao,
Holger
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question Question
PDF Create button to manage output formatting
Replies
0
Views
906
grabrail
G
S
  • Solved
Gathering Data From Multiple Files in Same Folder in Particular Range
9 10 11
Replies
105
Views
2K
shah0101
S
V
  • Question Question
autofilter
Replies
2
Views
398
vmjan02
V
S
  • Question Question
Creating new sheets from template sheet plugging data into new sheets with particular criterias
Replies
1
Views
713
mumps
mumps
N
  • Question Question
Pivot graph data when creating a new tab from a template.
Replies
0
Views
258
Nippyzap
N

Forum statistics

Threads
1,224,823
Messages
6,181,185
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top