So what I'm trying to do is I have a wire number report from AutoCAD and I'm taking the wire numbers from the report and transferring them into the wire label printer software for our shop to print.
Making the report is easy; Using the printer software and printing the labels is easy.
It's the difficulty of sorting the wire labels in the excel file that's giving me problems. I can manually sort the wire numbers into their own files just fine but I'm ultimately trying to automate this part of the process.
So I've uploaded an image of raw data next to the 6 sorted and finished excel files.
As you can see the report separates by wire the wire tag from AutoCAD which is just by wire color and wire gauge. The wire color doesn't matter. Each Wire size has it's own mark tube wire label except for the 16 and 18 gauge; they both can fit in the 3.2mm tube but for simplicity sake I've just kept them separate anyway.
So each set of wire labels will need to go to their separate file for further processing by the printer. They will eventually be changed to .csv files but those are a pain to work with so I'm doing that part last and it's simple to do anyway.
WireLabels - 18AWG - 3.2mm .xlsm
WireLabels - 16AWG - 3.2mm .xlsm
WireLabels - 14AWG - 3.6mm .xlsm
WireLabels - 12AWG - 4.2mm .xlsm
WireLabels - 10AWG - 5.0mm .xlsm
WireLabels - 8AWG - 6.0mm .xlsm
WireLabels - 6AWG - 8.0mm .xlsm
I'm basically trying to figure out how to loop down through the column and sort each set of wire numbers to their own file.
It's pretty simple to do with a set range of numbers but with differing reports from AutoCAD from project to project I can't set specific ranges like a range from A5 to A8 and that's where I'm stuck... I've been trying to select a range down to the blank cell past each bit of numbers but can't past that point.
ANY insight would be amazing. Thanks!
Can you please show your existing code or what you've tried thus far?
Sub NewSheets()
'
' Macro1 Macro
'This is is just to have a place to send the groups of numbers for now.
'They will eventually go to their own new workbooks
'
Sheets.Add After:=ActiveSheet
Sheets.Add After:=ActiveSheet
Sheets.Add After:=ActiveSheet
Sheets.Add After:=ActiveSheet
Sheets("Sheet1").Select
End Sub
Sub wires14()
Range("A64:A69").Select
Selection.Cut
Sheets("Sheet3").Select
ActiveSheet.Paste
Dim wb As Workbook
'// Set as reference to a new, one-sheet workbook. //
Set wb = Workbooks.Add(xlWBATWorksheet)
With wb
'// Skip selecting the sheet, just reference it explicitly and copy it after//
'// the blank sheet in the new wb. //
ThisWorkbook.Worksheets("sheet3").Copy After:=.Worksheets(.Worksheets.Count)
'// Kill alerts, delete the blank sheet in the new wb and turn alerts back on//
Application.DisplayAlerts = False
.Worksheets(1).Delete
Application.DisplayAlerts = True
'// SaveAs the new workbook to whatever path and close. //
.SaveAs Filename:="C:\Users\Public\Desktop\" & "14AWG - 4.6mm"
.Close False
End With
ActiveCell.Offset(rowOffset:=3, columnOffset:=3).Activate
Sheets("Sheet1").Select
End Sub
SO I have a button that can sort the selection and save it as file but automatically going through, finding, and selecting without specifically calling out a set range of cells is where I got stuck.
This bit I tried can select the specific wire number and copy the following numbers to a new sheet but, again, it only will grab the specified range and wouldn't be able to deal with a changing range.
Sub NewSheets()
'
' Macro1 Macro
'This is is just to have a place to send the groups of numbers for now.
'They will eventually go to their own new workbooks
'
Sheets.Add After:=ActiveSheet
Sheets.Add After:=ActiveSheet
Sheets.Add After:=ActiveSheet
Sheets.Add After:=ActiveSheet
Sheets("Sheet1").Select
End Sub
Sub LoopThruA()
Columns("A:A").Select
Selection.Find(What:="_18", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Select
Range(Selection, "A32").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
Also, are BLU 18 and BLK 16 going to be the only wires that share a workbook?
6 gauge, 8, gauge, 10 gauge, 12 gauge, and 14 gauge will all have their own workbook. 16 gauge, 18 gauge, and ALL other tags that aren't mentioned above will be on the same workbook. This is the case because 'cable' labels and much larger gauge wires will use the 3.2mm tubes strung through a zip tie and simply wrapped around.
Will all these wire numbers always be in the same order (I understand the number of rows will change).
The order will always be alphabetical/numerical based on the "(Wire Label)Wire Layer:BLK_12_MTW" section header So an example order would be
(Wire Label)Wire Layer:BLK_12_MTW
(Wire Label)Wire Layer:BLK_16_MTW
(Wire Label)Wire Layer:BLK_16_THHN_FW
(Wire Label)Wire Layer:BLK_18_MTW
(Wire Label)Wire Layer:BLK_2_MTW (2 gauge wire)
(Wire Label)Wire Layer:BLK_2-0_MTW (2 ought wire)
(Wire Label)Wire Layer:BLK_4_MTW
(Wire Label)Wire Layer:BLK_6_MTW
(Wire Label)Wire Layer:BLU_18_MTW
(Wire Label)Wire Layer:BLU_18_THHN_FW
(Wire Label)Wire Layer:CABLE
(Wire Label)Wire Layer:FIELDWIRE
(Wire Label)Wire Layer:RED_18_MTW
(Wire Label)Wire Layer:WHT_18_MTW
If not the same order, will the text in their description boxes change?
The first part(LEFT) of the text will NOT change "(Wire Label)Wire Layer:".
Are these the only wire labels you'll ever have to do this for, or could there be others?
With different colors there can be the same size wire but they will all go to the same new workbook together. There are 25 different wire gauge designations we use and a small assortment of other wire label markers such as "Cable" "Cable Trunk" "FieldWires" "_Multi_WIRE" and "Multiconductor"
The wire sizes we use are as follows.
18
16
14
12
10
8
6
4 (4 gauge)
4-0 (4 ought)
3 (3 gauge)
3-0 (3 ought, etc...)
2
2-0
1
1-0
250
300
350
400
500
600
700
750
800
900
1000
Each number will have a trailing designation such as _MTW or _THHN_FW.
And the possible colors if it matters are...
BLK
BLU
BRN
GRN
ORG
RED
WHT-BLU
WHT
YEL
Is it possible that there might be no rows at all for a specific wire label?
Nope, if there aren't any wires on a wire layer it wont be on the report.
CODE EDIT/UPDATE So this is what we have working for now. It works. It's not perfect but it does the job.
Option Explicit
Sub DivideWireLabels()
Dim i As Long, j As Long, K As Long
Dim sht As Worksheet, ws As Worksheet
Dim wb As Workbook
Workbooks("OpenAndRunWireLabel SortTool.xls").Activate
'Add a worksheet for each category
With ActiveWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "WireLabels - 16-18 & All Others"
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "WireLabels - 14 AWG - 3_6mm"
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "WireLabels - 12 AWG - 4_2mm"
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "WireLabels - 10 AWG - 5_0mm"
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "WireLabels - 8 AWG - 6_0mm"
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "WireLabels - 6 AWG - 8_0mm"
End With
Sheets("Sheet1").Activate
'Loop thru the column
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
'Find the wire layer cell
If InStr(Cells(i, 1).Value, "Wire Layer") > 0 Then
'if the wire layer is there, make a new sheet for it
If InStr(Cells(i, 1).Value, "_14_") > 0 Then
Set sht = Worksheets("WireLabels - 14 AWG - 3_6mm")
ElseIf InStr(Cells(i, 1).Value, "_12_") > 0 Then
Set sht = Worksheets("WireLabels - 12 AWG - 4_2mm")
ElseIf InStr(Cells(i, 1).Value, "_10_") > 0 Then
Set sht = Worksheets("WireLabels - 10 AWG - 5_0mm")
ElseIf InStr(Cells(i, 1).Value, "_8_") > 0 Then
Set sht = Worksheets("WireLabels - 8 AWG - 6_0mm")
ElseIf InStr(Cells(i, 1).Value, "_6_") > 0 Then
Set sht = Worksheets("WireLabels - 6 AWG - 8_0mm")
Else
Set sht = Worksheets("WireLabels - 16-18 & All Others")
End If
'Take the data and put it in one of the new sheets
For j = i + 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Trim(Cells(j, 1).Value) <> "" Then
K = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row
If Trim(sht.Cells(K, 1).Value) = "" Then
Cells(j, 1).Copy
sht.Cells(K, 1).PasteSpecial
Else
Cells(j, 1).Copy
sht.Cells(K + 1, 1).PasteSpecial
End If
Else
i = j
Exit For
End If
Next j
End If
Next i
'Clear clipboard
Application.CutCopyMode = False
'delete sheets 2 and 3
Dim s As Worksheet, t As String
Dim L As Long, M As Long
M = Sheets.Count
For L = M To 1 Step -1
t = Sheets(L).Name
If t = "Sheet2" Or t = "Sheet3" Then
Application.DisplayAlerts = False
Sheets(L).Delete
Application.DisplayAlerts = True
End If
Next L
'Create a workbook for each new worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Sheet1" Then
Set wb = ws.Application.Workbooks.Add
ws.Copy Before:=wb.Sheets(1)
wb.SaveAs "C:\Users\Public\Desktop\" & ws.Name, FileFormat:=xlCSV
Set wb = Nothing
End If
Next ws
ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.Close SaveChanges:=True
Dim x As Variant
Dim Path As String
' Set the Path variable equal to the path of your program's installation
Path = "C:\Program Files\Nisca Corporation\M-1ProVPC\MKP5PC.exe"
x = Shell(Path, vbNormalFocus)
End Sub
