Complex number assignment HELP.

vlmiller845

New Member
Joined
Oct 5, 2020
Messages
23
Office Version
  1. 2010
Platform
  1. Windows
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 NameColor PositionReplacement PositionHow many needles are available:10Need keyed
11027Dolphin1How many thread colors are in the pattern?26should auto select
21360Dusty Blue2How many color changes are in the design?57should auto select
31001Super White3Needle assignment
41010Gray Haze4Assign the number of available needles to the first available thread colors
51360Dusty Blue2Look in #1 for the number of available needles
61118Overcast Gray5If the thread color is used more than once then assign the same needle number to that same color
71160Antique Blue6After all the needles are assigned and if the number of thread colors are greater then the number of needles then
81363Steel Lavender7reassignment of the needles is necessary so when the thread color is supposed to be used it is available for the design
91240Stone8All thread colors and thread color changes have to be assigned a needle; otherwise it cannot be used
101164Twister9If there is a thread color that needs assigned to a needle and there are no needles available then
111364Storm Sky Blue10one of the needles will need to be reassigned to that thread color.
121368Night Sky1When deciding which needle to use; determine if there are any thread colors that are used only once
131071Baby's Breath6If there are, then take one of those needles and assign it to the thread color
141149Tusk7If not, then take a needle that has the least amount of threads assigned.
151001Super White3If a needle is reassigned then the new needle assignment is put in the replacement position for the first time
161118Overcast Gray5and if used for the same color after that position then the needle number is put in the Thread color position column
171010Gray Haze4If the needle that has been reassigned was used for a color that is still in use then that needle position must change
181149Tusk7You cannot assign a needle position without making sure it is not used by a different color below; if it is the needle position
191118Overcast Gray5below must change.
201062Rhino10Continue assigning needles to all thread colors and color changes until they are all assigned.
211041Polished Pewter6Try to minimize the number of thread color changes, efficiency is important
221240Stone8
231273Peanut Brittle1
241138Doe Skin2
251144Bark7
261230Root Beer5
271273Peanut Brittle1
281059Dark Chocolate7
291368Night Sky5
301360Dusty Blue7
311273Peanut Brittle1
321138Doe Skin2
331157Marsh5
341156Olive Green7
351105Weeping Willow5
361000Emerald Black7
371001Super White3
381010Gray Haze4
391118Overcast Gray1
401062Rhino10
411240Stone8
421041Polished Pewter6
431164Twister9
441241Obsidian2
451068Canary5
461000Emerald Black7
471001Super White3
481010Gray Haze4
491118Overcast Gray1
501062Rhino10
511240Stone8
521164Twister9
531041Polished Pewter6
541241Obsidian2
551000Emerald Black7
561010Gray Haze4
571001Super White3
CountMadeira Color #Madeira Color
11000Emerald Black
21001Super White
31010Gray Haze
41027Dolphin
51041Polished Pewter
61059Dark Chocolate
71062Rhino
81068Canary
91071Baby's Breath
101105Weeping Willow
111118Overcast Gray
121138Doe Skin
131144Bark
141149Tusk
151156Olive Green
161157Marsh
171160Antique Blue
181164Twister
191230Root Beer
201240Stone
211241Obsidian
221273Peanut Brittle
231360Dusty Blue
241363Steel Lavender
251364Storm Sky Blue
261368Night Sky
26Number of Colors
Embroidered Item
Hoop Size
Size of Pattern7.64" W X 11.8" H
Number of Stitches225,128
Time to embroider
Number of Colors26
 
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
 
Upvote 0
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...
VBA 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..
VBA Code:
Call Embroider
 
Upvote 0
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!
 
Upvote 0

Forum statistics

Threads
1,226,837
Messages
6,193,249
Members
453,784
Latest member
Chandni

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