Complex number assignment HELP.

[vlmiller845]

Hello, I have been trying to run this problem through ChatGPT, but it cannot get the solution correctly. I am trying to create a template to automatically assign and/or reassign a number based on a couple of criteria. I am not sure if this is the right place to go, but I have watched so many Mr. Excel videos, he is the 1st person I thought of that could potentially help, along with all the other brilliant minds that contribute here. So here is goes: I will upload my worksheet, but want to provide some context to the issue. I machine embroider and I have to manually type data into a spreadsheet so I can assign a needle position to the thread color that needs to be used for the design. I am trying to minimize the number of times I have to change the thread so efficient assignment is the goal. Below is a sample of the spreadsheet I use and some comments of how I manually assign the needle positions. I appreciate any help that can be provided. Thank you.

Snowy Owl
Color Change #	Color#	Color Name	Color Position	Replacement Position	How many needles are available:	10	Need keyed
1	1027	Dolphin	1	How many thread colors are in the pattern?	26	should auto select
2	1360	Dusty Blue	2	How many color changes are in the design?	57	should auto select
3	1001	Super White	3	Needle assignment
4	1010	Gray Haze	4	Assign the number of available needles to the first available thread colors
5	1360	Dusty Blue	2	Look in #1 for the number of available needles
6	1118	Overcast Gray	5	If the thread color is used more than once then assign the same needle number to that same color
7	1160	Antique Blue	6	After all the needles are assigned and if the number of thread colors are greater then the number of needles then
8	1363	Steel Lavender	7	reassignment of the needles is necessary so when the thread color is supposed to be used it is available for the design
9	1240	Stone	8	All thread colors and thread color changes have to be assigned a needle; otherwise it cannot be used
10	1164	Twister	9	If there is a thread color that needs assigned to a needle and there are no needles available then
11	1364	Storm Sky Blue	10	one of the needles will need to be reassigned to that thread color.
12	1368	Night Sky	1	When deciding which needle to use; determine if there are any thread colors that are used only once
13	1071	Baby's Breath	6	If there are, then take one of those needles and assign it to the thread color
14	1149	Tusk	7	If not, then take a needle that has the least amount of threads assigned.
15	1001	Super White	3	If a needle is reassigned then the new needle assignment is put in the replacement position for the first time
16	1118	Overcast Gray	5	and if used for the same color after that position then the needle number is put in the Thread color position column
17	1010	Gray Haze	4	If the needle that has been reassigned was used for a color that is still in use then that needle position must change
18	1149	Tusk	7	You cannot assign a needle position without making sure it is not used by a different color below; if it is the needle position
19	1118	Overcast Gray	5	below must change.
20	1062	Rhino	10	Continue assigning needles to all thread colors and color changes until they are all assigned.
21	1041	Polished Pewter	6	Try to minimize the number of thread color changes, efficiency is important
22	1240	Stone	8
23	1273	Peanut Brittle	1
24	1138	Doe Skin	2
25	1144	Bark	7
26	1230	Root Beer	5
27	1273	Peanut Brittle	1
28	1059	Dark Chocolate	7
29	1368	Night Sky	5
30	1360	Dusty Blue	7
31	1273	Peanut Brittle	1
32	1138	Doe Skin	2
33	1157	Marsh	5
34	1156	Olive Green	7
35	1105	Weeping Willow	5
36	1000	Emerald Black	7
37	1001	Super White	3
38	1010	Gray Haze	4
39	1118	Overcast Gray	1
40	1062	Rhino	10
41	1240	Stone	8
42	1041	Polished Pewter	6
43	1164	Twister	9
44	1241	Obsidian	2
45	1068	Canary	5
46	1000	Emerald Black	7
47	1001	Super White	3
48	1010	Gray Haze	4
49	1118	Overcast Gray	1
50	1062	Rhino	10
51	1240	Stone	8
52	1164	Twister	9
53	1041	Polished Pewter	6
54	1241	Obsidian	2
55	1000	Emerald Black	7
56	1010	Gray Haze	4
57	1001	Super White	3
Count	Madeira Color #	Madeira Color
1	1000	Emerald Black
2	1001	Super White
3	1010	Gray Haze
4	1027	Dolphin
5	1041	Polished Pewter
6	1059	Dark Chocolate
7	1062	Rhino
8	1068	Canary
9	1071	Baby's Breath
10	1105	Weeping Willow
11	1118	Overcast Gray
12	1138	Doe Skin
13	1144	Bark
14	1149	Tusk
15	1156	Olive Green
16	1157	Marsh
17	1160	Antique Blue
18	1164	Twister
19	1230	Root Beer
20	1240	Stone
21	1241	Obsidian
22	1273	Peanut Brittle
23	1360	Dusty Blue
24	1363	Steel Lavender
25	1364	Storm Sky Blue
26	1368	Night Sky
26	Number of Colors
Embroidered Item
Hoop Size
Size of Pattern	7.64" W X 11.8" H
Number of Stitches	225,128
Time to embroider
Number of Colors	26

 

[NdNoviceHlp]

Well that doesn't appear to dangerous. I was envisioning some type of industrial cotton gin thing that you don't want to show up hungover in the morning to operate. I may have to purchase one and take up embroidering now that I seem to have figured out how to set it up I'm busy for a while so I'll post some code later. Dave

 

[vlmiller845]

thank you, I am very excited

 

[NdNoviceHlp]

It's been literally in the -30sC and -40sC with the windchill here on the Canadian Prairies for the last week. So this was an interesting project to fill some indoor time. Set up sheet1 mostly like it seems that you have it above. A3 to whatever with colour change#, B3 to whatever with colour numbers, C3 to whatever with colour names. G2 with number of needles. G3 with number of colour changes. Total Colour output will be below your input. Needle position will be to the right of your input. So don't have anything in sheet1 below or to the right of your input data. The output data will adapt to the amount of your input data. It seems like others with a similar machine may find the code useful and hopefully this code will work for you. Good luck. Dave
You can place this in sheet1 code...

Option Explicit
Dim NeedleArr() As Variant, ColorArr() As Variant, ccc As Integer, cc As Integer, LastNeedle As Integer

Sub Embroider()
Dim LastRow As Integer, Rcnt As Integer, Cnt10 As Integer, Cnt11 As Integer, Cnt As Integer
Dim ArCnt As Integer, Cnter As Integer, Cnt2 As Integer, Total As Integer
'# of needles in Sheet1 G2
'# of needle changed in Sheet1 G3
'Input Color change number in sheet1 A3 to whatever, color number B3 to whatever, color name in C3 to whatever
'Output color positions sheet1 D3 to whatever, replacement positions in E3 to whatever
'output needle pattern sheet1 K2 to whatever
'output separate colours, names and needle changes required sheet1 A to D below input
'**remove comments to output ColorArr below needle pattern
'output adapts to changes in input

'remove previous data
Call CleanUp

'ccc = 12 'output column for ColorArr(not needed unless ColorArr displayed)

With Sheets("Sheet1")
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
'bubble sort colours
Rcnt = LastRow + 2
For Cnt10 = 3 To LastRow
For Cnt11 = 3 To (Cnt10 - 1)
If Sheets("Sheet1").Range("B" & Cnt11).Value = Sheets("Sheet1").Range("B" & Cnt10).Value Then ' more than one entry
GoTo bart
End If
Next Cnt11
Rcnt = Rcnt + 1
Sheets("Sheet1").Range("A" & Rcnt).Value = Rcnt - LastRow - 2
Sheets("Sheet1").Range("B" & Rcnt).Value = Sheets("Sheet1").Range("B" & Cnt10).Value
Sheets("Sheet1").Range("C" & Rcnt).Value = Sheets("Sheet1").Range("C" & Cnt10).Value
bart:
Next Cnt10
Sheets("Sheet1").Range("C" & Rcnt + 1).Value = "Total"

'put colours in array
ReDim ColorArr(Sheets("Sheet1").Range("A" & Rcnt).Value, 3)
' ColorArr(Separate colours, 0) = colour number
' ColorArr(Separate colours, 1) = colour name
' ColorArr(Separate colours, 2) = colour changes
ArCnt = 0
For Cnt = (LastRow + 3) To Rcnt
ColorArr(ArCnt, 0) = Sheets("Sheet1").Range("B" & Cnt).Value
ColorArr(ArCnt, 1) = Sheets("Sheet1").Range("C" & Cnt).Value
ArCnt = ArCnt + 1
Next Cnt
For Cnt2 = 3 To LastRow
For Cnt = LBound(ColorArr) To UBound(ColorArr) - 1
If Sheets("Sheet1").Range("B" & Cnt2).Value = ColorArr(Cnt, 0) Then
ColorArr(Cnt, 2) = ColorArr(Cnt, 2) + 1
End If
Next Cnt
Next Cnt2

' output colour changes
For Cnt = LBound(ColorArr) To UBound(ColorArr) - 1
Sheets("Sheet1").Range("D" & (LastRow + 3 + Cnt)).Value = ColorArr(Cnt, 2)
Total = Total + ColorArr(Cnt, 2)
Next Cnt
Sheets("Sheet1").Range("D" & (LastRow + 3 + Cnt)).Value = Total

'set up needle array
ReDim NeedleArr(Sheets("Sheet1").Range("G" & 2).Value)

cc = 11 'output column for needle change display
'loop through pattern
For Cnter = 3 To LastRow
'call function to load/output color positions
Sheets("Sheet1").Range("D" & Cnter).Value = LoadNeedle(Cnter)
If Sheets("Sheet1").Range("D" & Cnter).Value = 0 Then
Sheets("Sheet1").Range("D" & Cnter).Value = vbNullString
' call function to load/output replacement positions
Sheets("Sheet1").Range("E" & Cnter).Value = ChangeNeedle(Cnter)
Sheets("Sheet1").Cells(1, cc).Value = "CHANGE " & cc - 11
'output needle set up after needle change
For Cnt = LBound(NeedleArr) To UBound(NeedleArr) - 1
Sheets("Sheet1").Cells(Cnt + 2, cc).Value = NeedleArr(Cnt)
Next Cnt
cc = cc + 1
End If
Next Cnter
End Sub

Function FindNeedle() As Integer
'change needle to needle no longer needed
'get needle not in colorarr
Dim Cnt As Integer, Cnt2 As Integer, Cnt3 As Integer, Tint As Integer, Max As Integer
For Cnt = LBound(NeedleArr) To UBound(NeedleArr) - 1
For Cnt2 = LBound(ColorArr) To UBound(ColorArr) - 1
If ColorArr(Cnt2, 0) = NeedleArr(Cnt) Then
Exit For
End If
'get max needle separartion
Tint = Abs(LastNeedle - Cnt)
If Tint <> LastNeedle Then
For Cnt3 = LBound(ColorArr) To UBound(ColorArr) - 1
If ColorArr(Cnt3, 0) = NeedleArr(Tint) Then
GoTo Below
End If
Next Cnt3
    If Tint > Max Then
    Max = Tint
    End If
End If
Below:
Next Cnt2
Next Cnt
FindNeedle = Max
End Function

Function LoadNeedle(Rcnt As Integer) As Integer
Dim TempArr() As Variant, Cnt3 As Integer, Cnt4 As Integer, Cnt5 As Integer
Dim i As Integer, Cnt2 As Integer, Cnt As Integer, Flag As Boolean
For Cnt3 = LBound(NeedleArr) To UBound(NeedleArr) - 1
'load all needles to start
If NeedleArr(Cnt3) = vbNullString Then
Flag = False
For Cnt4 = LBound(NeedleArr) To UBound(NeedleArr) - 1
If NeedleArr(Cnt4) = Sheets("Sheet1").Range("B" & Rcnt).Value Then
Flag = True
Exit For
End If
Next Cnt4
If Not Flag Then
LoadNeedle = Cnt3 + 1
LastNeedle = Cnt3
NeedleArr(Cnt3) = Sheets("Sheet1").Range("B" & Rcnt).Value
For Cnt5 = LBound(ColorArr) To UBound(ColorArr) - 1
If NeedleArr(Cnt3) = ColorArr(Cnt5, 0) Then
ColorArr(Cnt5, 2) = ColorArr(Cnt5, 2) - 1
If ColorArr(Cnt5, 2) = 0 Then
Call RemoveItem(Cnt5)
End If
Exit For
End If
Next Cnt5
'display starting needles
If NeedleArr(UBound(NeedleArr) - 1) <> vbNullString Then
Sheets("Sheet1").Cells(1, cc).Value = "Start"
For Cnt = LBound(NeedleArr) To UBound(NeedleArr) - 1
Sheets("Sheet1").Cells(Cnt + 2, cc).Value = NeedleArr(Cnt)
Next Cnt
cc = cc + 1
End If
Exit Function
End If
End If
Next Cnt3
'load existing needles
For Cnt = LBound(ColorArr) To UBound(ColorArr) - 1
If Sheets("Sheet1").Range("B" & Rcnt).Value = ColorArr(Cnt, 0) Then
For Cnt2 = LBound(NeedleArr) To UBound(NeedleArr) - 1
If NeedleArr(Cnt2) = ColorArr(Cnt, 0) Then
ColorArr(Cnt, 2) = ColorArr(Cnt, 2) - 1
    If ColorArr(Cnt, 2) = 0 Then
    Call RemoveItem(Cnt)
    End If
NeedleArr(Cnt2) = Sheets("Sheet1").Range("B" & Rcnt).Value
LoadNeedle = Cnt2 + 1
Exit Function
End If
Next Cnt2
End If
Next Cnt
End Function

Function ChangeNeedle(Rcnt As Integer) As Integer
Dim TempArr() As Variant, Max As Integer, Nnum As Integer, Cnt As Integer
Dim Cnt3 As Integer, Cnt4 As Integer, i As Integer, Tint As Integer
'find colour number
For Cnt = LBound(ColorArr) To UBound(ColorArr) - 1
If ColorArr(Cnt, 0) = Sheets("Sheet1").Range("B" & Rcnt).Value Then
ColorArr(Cnt, 2) = ColorArr(Cnt, 2) - 1
Nnum = FindNeedle
'all needles in use have remaining stitches
If Nnum = 0 And ColorArr(Cnt, 2) > 1 Then
For Cnt3 = LBound(NeedleArr) To UBound(NeedleArr) - 1
For Cnt4 = LBound(ColorArr) To UBound(ColorArr) - 1
If NeedleArr(Cnt3) = ColorArr(Cnt4, 0) Then
'get largest remaining
If Cnt3 <> LastNeedle Then
If ColorArr(Cnt4, 2) > Max Then
Max = ColorArr(Cnt4, 2)
Tint = Cnt3
End If
End If
End If
Next Cnt4
Next Cnt3
'output needle change/load array
ChangeNeedle = Tint + 1
NeedleArr(Tint) = Sheets("Sheet1").Range("B" & Rcnt).Value
LastNeedle = Tint
Exit For
Else
'change needle to needle no longer needed
'output needle change/load array
ChangeNeedle = Nnum + 1
NeedleArr(Nnum) = Sheets("Sheet1").Range("B" & Rcnt).Value
LastNeedle = Nnum
Exit For
End If
End If
Next Cnt
'remove colur from array if no longer needed
If ColorArr(Cnt, 2) = 0 Then
Call RemoveItem(Cnt)
End If

'Remove comments to display ColorArr
'Tint = Sheets("Sheet1").Range("G" & 2).Value
'For Cnt3 = LBound(ColorArr) To UBound(ColorArr) - 1
'Sheets("Sheet1").Cells(Cnt3 + Tint + 3, ccc).Value = ColorArr(Cnt3, 0)
'Next Cnt3
'ccc = ccc + 1
End Function

Function RemoveItem(Rcnt As Integer)
Dim i As Integer
'remove colour from ColorArr
ReDim TempArr(UBound(ColorArr) - 1, 3)
For i = LBound(TempArr) To Rcnt - 1
TempArr(i, 0) = ColorArr(i, 0)
TempArr(i, 1) = ColorArr(i, 1)
TempArr(i, 2) = ColorArr(i, 2)
Next i
For i = Rcnt To UBound(TempArr) - 1
TempArr(i, 0) = ColorArr(i + 1, 0)
TempArr(i, 1) = ColorArr(i + 1, 1)
TempArr(i, 2) = ColorArr(i + 1, 2)
Next i
ColorArr = TempArr
End Function

Sub CleanUp()
'Remove previous data
Dim LastRow As Integer, LastCol As Integer, Tint As Integer
With Sheets("Sheet1")
LastRow = .Range("L" & .Rows.Count).End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(1, "K"), .Cells(LastRow, LastCol)).ClearContents
Tint = Sheets("Sheet1").Range("G" & 3).Value
.Range(.Cells(3, "D"), .Cells(Tint + 2, "E")).ClearContents
LastRow = .Range("C" & .Rows.Count).End(xlUp).Row
.Range(.Cells(Tint + 4, "A"), .Cells(LastRow, "D")).ClearContents
End With
End Sub

To operate run the Embroider sub..

Call Embroider

 

[vlmiller845]

Oh my, I am so excited. I will let you know how it works for me. Wow, I am in Orlando, FL so I have never seen temperatures like that, stay warm! Thank you SO MUCH!

 

[NdNoviceHlp]

Whoops! Testing the code out a bit more and the "CleanUp" sub posted above needs amendment. Remove it and replace it with this...

Sub CleanUp()
'Remove previous data
Dim LastRow As Integer, LastCol As Integer, Tint As Integer
With Sheets("Sheet1")
LastRow = .Range("L" & .Rows.Count).End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(1, "K"), .Cells(LastRow, LastCol)).ClearContents
Tint = Sheets("Sheet1").Range("G" & 3).Value
.Range(.Cells(3, "D"), .Cells(Tint + 2, "E")).ClearContents
LastRow = .Range("C" & .Rows.Count).End(xlUp).Row
If LastRow - 2 <> Tint Then
.Range(.Cells(Tint + 4, "A"), .Cells(LastRow, "D")).ClearContents
End If
End With
End Sub

Dave