VBA help coding (seems simple)

positiev

New Member
Joined
Jun 24, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows
Hello,

I have a worksheet with data, where i have cable numbers with all the information how, type, from, to, routing etc.
And i have a sheet with a pulldown to all the cables the of the form fills by vertical searching in the other sheet.

So all information gets produced only have to do this by hand now for all 1887 cable numbers..

What i would like to have is a button which makes a new worksheet, get the next cable number, renames the sheet to this number, and so on.
So 1 sheet per cable.
Best would be 1 click and done for all numbers.

I was wondering if someone could make this work for me.
tried ton of googling but didn't find the answer.

Thanks in advance.


Button i have managed to copy the sheet, but thats all.

Public Sub CopySheetAndRenameByCell2()
Dim wks As Worksheet
Set wks = ActiveSheet
ActiveSheet.Copy After:=Worksheets(Sheets.Count)
If wks.Range("A1").Value <> "" Then
On Error Resume Next
ActiveSheet.Name = wks.Range("E3").Value
End If

wks.Activate
End Sub
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Welcome to Mr. Excel,

Would you use XL2BB to show a sample of your data, please?
 
Upvote 0
CABLE_PULL_CARD.xlsm
BCDEFGHIJKLMN
1CABLE_NOWP_NOFROM_EQUIPFROM_DESCTO_EQUIPTO_DESCDESIGNLENGTH_MCABLE_TYPECABLE_DESC_APCABLE_OD_MMREMARKS1
20-E-354970-EA-H15-01PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-H15-02PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1034HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
30-E-354960-EA-H16-01PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-H15-01PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1034HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
40-E-354940-EA-H17-01PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-H17-02PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1034HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
50-E-354950-EA-H17-02PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-H16-01PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1034HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
60-E-354920-EA-H18-01PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-H18-02PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1034HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
70-E-354930-EA-H18-02PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-H17-01PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1034HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
80-E-354910-EA-H19-01PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-H18-01PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1027HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
90-E-355140-EA-I15-01CHALMIT PR3I/02L/LE LED FIXTURE CANTILEVERED OFF STEEL COLUMN (L06)0-EA-I15-02CHALMIT PR3I/02L/LE LED FIXTURE CANTILEVERED OFF STEEL COLUMN (L06)2x412KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
100-E-355150-EA-I15-02CHALMIT PR3I/02L/LE LED FIXTURE CANTILEVERED OFF STEEL COLUMN (L06)0-EA-I15-03CHALMIT PR3I/02L/LE LED FIXTURE CANTILEVERED OFF STEEL COLUMN (L06)2x48KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
110-E-356140-EA-I15-05CHALMIT PR3I/07L/LE LED FIXTURE MOUNTED ON POLE AT GROUND LEVEL (L07)0-EA-I15-04CHALMIT PR3I/07L/LE LED FIXTURE MOUNTED ON POLE AT GROUND LEVEL (L07)2x415KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
120-E-354620-EA-I15-08PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-J15-09PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1034HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
130-E-354520-EA-I15-09PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-I15-10PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1056HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
140-E-354530-EA-I15-10PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-I16-02PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1053HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
150-E-354540-EA-I16-02PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-I16-03PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1036HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
160-E-354550-EA-I16-03PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-I17-01PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1034HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
170-E-356180-EA-I16-22CHALMIT PR3I/02L/LE LED FIXTURE MOUNTED ON POLE AT GROUND LEVEL (L07)0-EA-I16-23CHALMIT PR3I/02L/LE LED FIXTURE MOUNTED ON POLE AT GROUND LEVEL (L07)2x416KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
180-E-354560-EA-I17-01PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-I17-02PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1026HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
190-E-354570-EA-I17-02PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-I17-03PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1053HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
200-E-354580-EA-I17-03PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-I18-07PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1041HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
210-E-354600-EA-I18-06PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-I18-05PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1034HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
220-E-354590-EA-I18-07PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-I18-06PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1044HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
230-E-355970-EA-I18-25CHALMIT PR3I/07L/LE LED FIXTURE HANDRAIL MOUNTED (L01)P-EA-I18-29CHALMIT PR3I/07L/LE LED FIXTURE HANDRAIL MOUNTED (L01)2x420KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
240-E-355980-EA-I18-26CHALMIT PR3I/07L/LE LED FIXTURE HANDRAIL MOUNTED (L01)P-EA-I18-30CHALMIT PR3I/07L/LE LED FIXTURE HANDRAIL MOUNTED (L01)2x423KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
250-E-356000-EA-I18-28CHALMIT PR3I/07L/LE LED FIXTURE HANDRAIL MOUNTED (L01)P-EA-I18-26CHALMIT PR3I/07L/LE LED FIXTURE HANDRAIL MOUNTED (L01)2x420KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
260-E-356010-EA-I18-29CHALMIT PR3I/07L/LE LED FIXTURE HANDRAIL MOUNTED (L01)P-EA-I18-27CHALMIT PR3I/07L/LE LED FIXTURE HANDRAIL MOUNTED (L01)2x423KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
270-E-354900-EA-I19-01PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-H19-01PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1030HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
280-E-354800-EA-I19-02PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-J19-01PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1034HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
290-E-355040-EA-J15-01CHALMIT PR3I/02L/LE LED FIXTURE MOUNTED ON STEEL COLUMN (L05)0-EA-J15-05CHALMIT PR3I/02L/LE LED FIXTURE MOUNTED ON STEEL COLUMN (L05)2x49KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
300-E-353570-EA-J15-02CHALMIT PR3I/07L/LE LED FIXTURE MOUNTED BELOW BEAM (L02)0-EA-J15-01CHALMIT PR3I/02L/LE LED FIXTURE MOUNTED ON STEEL COLUMN (L05)2x417KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
310-E-355020-EA-J15-03CHALMIT PR3I/07L/LE LED FIXTURE MOUNTED BELOW BEAM (L02)0-EA-J15-02CHALMIT PR3I/07L/LE LED FIXTURE MOUNTED BELOW BEAM (L02)2x48KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
320-E-356100-EA-J15-04CHALMIT PR3I/02L/LE LED FIXTURE MOUNTED ON STEEL COLUMN (L05)0-EA-J16-12CHALMIT PR3I/07L/LE LED FIXTURE MOUNTED BELOW BEAM (L02)2x428KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
330-E-355050-EA-J15-05CHALMIT PR3I/02L/LE LED FIXTURE MOUNTED ON STEEL COLUMN (L05)0-EA-J16-11CHALMIT PR3I/02L/LE LED FIXTURE MOUNTED ON STEEL COLUMN (L05)2x420KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
340-E-356130-EA-J15-06CHALMIT PR3I/02L/LE LED FIXTURE MOUNTED ON STEEL COLUMN (L04)0-EA-I15-05CHALMIT PR3I/07L/LE LED FIXTURE MOUNTED ON POLE AT GROUND LEVEL (L07)2x425KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
350-E-355130-EA-J15-07CHALMIT PR3I/02L/LE LED FIXTURE CANTILEVERED OFF STEEL COLUMN (L06)0-EA-I15-01CHALMIT PR3I/02L/LE LED FIXTURE CANTILEVERED OFF STEEL COLUMN (L06)2x417KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
360-E-355120-EA-J15-07CHALMIT PR3I/02L/LE LED FIXTURE CANTILEVERED OFF STEEL COLUMN (L06)0-EA-J15-08CHALMIT PR3I/02L/LE LED FIXTURE MOUNTED ON POLE AT GROUND LEVEL (L07)2x411KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
370-E-354630-EA-J15-09PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-J15-10PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1034HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
380-E-354640-EA-J15-10PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE0-EA-K15-03PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE4x1053HZ1G-YMz1Kasmbzh, Cca-S1, d1, a120,7SITE-ROUTED
390-E-355100-EA-J15-11CHALMIT PR3I/02L/LE LED FIXTURE MOUNTED ON WALL (L08)0-EA-I15-06CHALMIT PR3I/02L/LE LED FIXTURE HANDRAIL MOUNTED (L01)2x425KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
400-E-355090-EA-J15-11CHALMIT PR3I/02L/LE LED FIXTURE MOUNTED ON WALL (L08)0-EA-I16-22CHALMIT PR3I/02L/LE LED FIXTURE MOUNTED ON POLE AT GROUND LEVEL (L07)2x425KZ1O-YMz1Kasmbzh, Cca-s1, d1, a115,3SITE-ROUTED
CABLE_PULL_CARD



CABLE_PULL_CARD.xlsm
ABCDE
1
2
3WP Nr.0Cable nr.0-E-35496
4
5From0-EA-H16-01To0-EA-H15-01
6DescriptionPHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTUREDescriptionPHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE
7
8Cable type4x10Z1G-YMz1Kasmbzh, Cca-S1, d1, a1Length34
9Diameter20,7 mm
10
11RouteSITE-ROUTED380
12120390
13130400
14140410
15150420
16160430
17170440
18180450
19190460
20200470
21210480
22220490
23230500
24240510
25250520
26260530
27270540
28280550
29290560
30300570
31310580
32320590
33330600
34340610
35350620
36360
0-E-35497
Cell Formulas
RangeFormula
C3C3=VLOOKUP($E$3,CABLE_PULL_CARD!B:BK,2,FALSE)
C5C5=VLOOKUP($E$3,CABLE_PULL_CARD!B:BK,3,FALSE)
C6C6=VLOOKUP($E$3,CABLE_PULL_CARD!B:BK,4,FALSE)
C7,E7C7=VLOOKUP($E$3,CABLE_PULL_CARD!B:C,2,FALSE)
C8C8=(VLOOKUP($E$3,CABLE_PULL_CARD!B:BK,7,FALSE)& VLOOKUP($E$3,CABLE_PULL_CARD!B:BK,10,FALSE))
E5E5=VLOOKUP($E$3,CABLE_PULL_CARD!B:BK,5,FALSE)
E6E6=VLOOKUP($E$3,CABLE_PULL_CARD!B:BK,6,FALSE)
E8E8=VLOOKUP($E$3,CABLE_PULL_CARD!B:BK,8,FALSE)
E9E9=CONCAT(VLOOKUP($E$3,CABLE_PULL_CARD!B:BK,11,FALSE), " mm")
E11:E24E11=VLOOKUP($E$3,CABLE_PULL_CARD!B:BK,D11+1,FALSE)
E25:E35E25=VLOOKUP($E$3,CABLE_PULL_CARD!B:BL,D25+1,FALSE)
C11C11=VLOOKUP($E$3,CABLE_PULL_CARD!B:BK,B$12+1,FALSE)
C12:C36C12=VLOOKUP($E$3,CABLE_PULL_CARD!B:BK,B13+1,FALSE)
Cells with Data Validation
CellAllowCriteria
E3List=CABLE_PULL_CARD!$B$2:$B$1888
 
Upvote 0
This might give you a start:

Code:
Sub CreateSheets()
 
'Dimension variables and declare data types
Dim rng As Range, lr As Long
Dim cell As Range
 
lr = Sheets("CABLE_PULL_CARD").Cells(Rows.Count, "B").End(xlUp).Row
'Enable error handling
On Error GoTo Errorhandling
 
Set rng = Range("B2:B" & lr)
 
'Iterate through cells in selected cell range
For Each cell In rng
    'Check if cell is not empty
    If cell <> "" Then
        'Insert worksheet and name the worksheet based on cell value
        Sheets.Add.Name = cell
'Insert details
      Range("E3") = cell
      Range("C5") = WorksheetFunction.VLookup(cell, Sheets("CABLE_PULL_CARD").Range("B2:N" & lr), 3, False)
    End If
'Continue with next cell in cell range
Next cell
 
'Go here if an error occurs
Errorhandling:

End Sub
 
Upvote 0
Cannot get it to work..
Think i will not get it to work, since my knowledge is less than zero.

Can add the code thats about it :p
 
Upvote 0
What is it that is NOT working? Did you put the code into a module?
 
Upvote 0
Here's an updated version:

Code:
Sub CreateSheets()
 
'Dimension variables and declare data types
Dim rng As Range, lr As Long
Dim cell As Range
 
lr = Sheets("CABLE_PULL_CARD").Cells(Rows.Count, "B").End(xlUp).Row
'Enable error handling
On Error GoTo Errorhandling
 
Set rng = Range("B2:B" & lr)
 
'Iterate through cells in selected cell range
For Each cell In rng
    'Check if cell is not empty
    If cell <> "" Then
        'Insert worksheet and name the worksheet based on cell value
        Sheets.Add.Name = cell
'Insert details
  ' boiler plate
  Range("B3") = "WP Nr."
  Range("D3") = "Cable nr."
  Range("B5") = "From"
  Range("D5") = "To"
  Range("B6") = "Description"
  Range("D6") = "Description"
  Range("B9") = "Cable type"
  Range("D8") = "Length"
  Range("D9") = "Diameter"
  Range("B11") = "Route"
  
  
      Range("E3") = cell
      Range("C5") = WorksheetFunction.VLookup(cell, Sheets("CABLE_PULL_CARD").Range("B2:N" & lr), 3, False)
      Range("C6") = WorksheetFunction.VLookup(cell, Sheets("CABLE_PULL_CARD").Range("B2:N" & lr), 4, False)
      Columns("C").ColumnWidth = 35
      Range("C6").WrapText = True
      Range("E6") = WorksheetFunction.VLookup(cell, Sheets("CABLE_PULL_CARD").Range("B2:N" & lr), 6, False)
      Columns("E").ColumnWidth = 35
      Range("E6").WrapText = True
      Range("E8") = WorksheetFunction.VLookup(cell, Sheets("CABLE_PULL_CARD").Range("B2:N" & lr), 8, False)
      Range("E9") = WorksheetFunction.VLookup(cell, Sheets("CABLE_PULL_CARD").Range("B2:N" & lr), 11, False) & " mm"
      Range("E8:E9").HorizontalAlignment = xlLeft
      Range("C8") = (WorksheetFunction.VLookup(cell, Sheets("CABLE_PULL_CARD").Range("B2:N" & lr), 7, False) & WorksheetFunction.VLookup(cell, Sheets("CABLE_PULL_CARD").Range("B2:N" & lr), 10, False))
      Range("B11") = "Route"
      Range("C11") = "SITE-ROUTED"
      Range("B3:B11", "D3:D11").Font.Bold = True
    End If
'Continue with next cell in cell range
Next cell
 
'Go here if an error occurs
Errorhandling:

End Sub
 
Upvote 0
It added a sheet, but only one value (from b3) and putted the data in e3.
So location of the data is correct.
The sheet (0-E-35497) is not Copied to a new sheet with the next cable number.

As said before, my knowledge is zero on this point.

Simple function description, hope this helps
Copy sheet
Add next value from sheet - CABLE_PULL_CARD column B - in sheet - 0-E-35497 cell E3
Rename sheet according cell e3

Until all rows are finished.

I really appriciate the effort:)
Thanks in advance
 
Upvote 0
Current:

Kopie van CABLE_PULL_CARD1.xlsm
ABCDEF
1
2
3WP Nr.Cable nr.WP Nr.
4
5FromTo
6DescriptionDescription
7
8Length
9Cable typeDiameter
10
11Route
12
13
WP Nr.


So still not copied the (template) sheet.
 
Upvote 0

Forum statistics

Threads
1,214,979
Messages
6,122,561
Members
449,089
Latest member
Motoracer88

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