VBA help coding (seems simple)

[positiev]

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

 

[kweaver]

The sheet on which you have the CABLE_NO should (a) be called "CABLE_PULL_CARD" and (b) the CABLE_NOs should be in column B, starting in row 2 (as row 1 has a header).
Then, with the macro in a MODULE, it should pull from that sheet and create as many sheets (and name them) as the CABLE_NOs in column B.

I used only a few of the ones you posted and as you can see from the images below, they were all created:

Book6
	B	C	D	E
1
2
3	WP Nr.		Cable nr.	0-E-35492
4
5	From	0-EA-H18-01	To
6	Description	PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE	Description	PHILIPS BGP615 T25 1 X LED10-4S/740 DW50 STREET LIGHT FIXTURE
7
8		4x10Z1G-YMz1Kasmbzh, Cca-S1, d1, a1	Length	34
9	Cable type		Diameter	20,7 mm
10
11	Route	SITE-ROUTED
12
0-E-35492

 

[positiev]

The sheet on which you have the CABLE_NO should (a) be called "CABLE_PULL_CARD" and (b) the CABLE_NOs should be in column B, starting in row 2 (as row 1 has a header).
Then, with the macro in a MODULE, it should pull from that sheet and create as many sheets (and name them) as the CABLE_NOs in column B.

I used only a few of the ones you posted and as you can see from the images below, they were all created:

You got it to work, with a few tweaks in your code, issue now is:
1888 sheets of information, is it possible to extract each sheet as a seperate workbook?

Within the same module?

 

[kweaver]

I suspect that the following is much faster rather than all of those VLOOKUP calls.

edit: oops. Mis-typed 2 lines...will repost.

As you now saying that you want all of those separate sheets to be their own workbook (1800+ of them) ?

 

[kweaver]

Should be faster.

Sub CreateSheets2()
 
'Dimension variables and declare data types
Dim rng As Range, lr As Long
Dim cell As Range, w As Long
 
lr = Sheets("CABLE_PULL_CARD").Cells(Rows.Count, "B").End(xlUp).Row
'Enable error handling
On Error GoTo Errorhandling
 
Set rng = Sheets("CABLE_PULL_CARD").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("B8") = "Cable type"
  Range("D8") = "Length"
  Range("D9") = "Diameter"
  Range("B11") = "Route"
  
      w = WorksheetFunction.Match(cell, Sheets("CABLE_PULL_CARD").Range("B1:B" & lr), 0)
      Range("E3") = cell
      Range("C5") = Sheets("CABLE_PULL_CARD").Cells(w, 4)
      Range("C6") = Sheets("CABLE_PULL_CARD").Cells(w, 5)
      Columns("C").ColumnWidth = 35
      Range("C6").WrapText = True
      Range("E5") = Sheets("CABLE_PULL_CARD").Cells(w, 6)
      Columns("E").ColumnWidth = 35
      Range("E6") = Sheets("CABLE_PULL_CARD").Cells(w, 7)
      Range("E6").WrapText = True
      Range("E8") = Sheets("CABLE_PULL_CARD").Cells(w, 9)
      Range("E9") = Sheets("CABLE_PULL_CARD").Cells(w, 12)
      Range("E8:E9").HorizontalAlignment = xlLeft
      Range("C8") = Sheets("CABLE_PULL_CARD").Cells(w, 8) & Sheets("CABLE_PULL_CARD").Cells(w, 11)
      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

 

[positiev]

I suspect that the following is much faster rather than all of those VLOOKUP calls.

edit: oops. Mis-typed 2 lines...will repost.

As you now saying that you want all of those separate sheets to be their own workbook (1800+ of them) ?

We'll yeah, thanks again btw..

Since scrolling through 1800 sheets is a pain in the a***.
If i have separate workbooks it is easier to sort them out in workpackages.