excelvbalistcheckboxdymo
VBA - Dynamic multi column list with checkboxes for printing labels (through a DYMO printer)
Context :
I work for a cars manufacturer firm, and I need to create an excel table permitting to generate a list which will be printed by a label printer of the brand DYMO.
These labels will have several data in a QR code.
The DYMO software can read an excel table, then print a bunch of labels.
It reads the excel table in a "line by line" manner, each line = 1 label printed, each column is a different data that can be integrated where we decide to.
here is the interface (yep, I'm french ^^,) :
Problem :
I actually have my lists under this form :
The idea is that a user can check the checkboxes to choose the data which will be in the labels, then generate a list through the green button "Create print sheet"
The top checkbox of every column, called "Print?" is to allow the user to generate labels for dealers (as example) but without having the dealer information on it (or content or other)
The result should look like this :
I coded it with "for loops" using an array in a way like that :
for each dealer
if checkbox checked
Write dealer in the 1st position of the dataarray
for each content
if checkbox checked
write content in the 2nd position of the dataarray
write Nb in 3rd position of the dataarray
for each CarModel
if checkbox checked
write car model in the 4th position of the dataarray
For i = 1 To Content.Value
For Each data In datarray
print that in the required column in the print sheet
Next
Next
End If
Next
End If
Next
End If
Next
Which gives :
For Each Dealer In Worksheets(MenuSheet).Range(PartnerListPos & FirstLine + 1 & ":" & PartnerListPos & PartnerListEnd) 'for each dealer
If Worksheets(MenuSheet).Range(Dealer.Address).Offset(0, 1).Value = True Then 'if the corresponding checkbox is checked
'to encode the data, if requested
Set EncodeDealer = Worksheets(MenuSheet).Range(EncodeInfoPos & FirstLine + 1 & ":" & EncodeInfoPos & EncodeInfoEnd).Find("Bugatti Dealers")
If EncodeDealer.Offset(0, 1) = True Then
FinalData(1) = EncodeDecode.Base64EncodeString(Dealer)
Else
FinalData(1) = Dealer
End If
For Each Content In Worksheets(MenuSheet).Range(ContentContentPos & FirstLine + 1 & ":" & ContentContentPos & ContentContentEnd) 'for each Content
If Worksheets(MenuSheet).Range(Content.Address).Offset(0, 2).Value = True Then 'if the corresponding checkbox is checked
'to encode the data, if requested
Set EncodeContentContent = Worksheets(MenuSheet).Range(EncodeInfoPos & FirstLine + 1 & ":" & EncodeInfoPos & EncodeInfoEnd).Find("Contents Nb.")
If EncodeDealer.Offset(0, 1) = True Then
FinalData(2) = EncodeDecode.Base64EncodeString(Worksheets(MenuSheet).Range(Content.Address).Offset(0, 1).Value)
Else
FinalData(2) = Worksheets(MenuSheet).Range(Content.Address).Offset(0, 1).Value
End If
For Each CarModel In Worksheets(MenuSheet).Range(CarsModelsPos & FirstLine + 1 & ":" & CarsModelsPos & CarsModelsEnd) 'for each car
If Worksheets(MenuSheet).Range(CarModel.Address).Offset(0, 1).Value = True Then 'if the corresponding checkbox is checked
'to encode the data, if requested
Set EncodeCar = Worksheets(MenuSheet).Range(EncodeInfoPos & FirstLine + 1 & ":" & EncodeInfoPos & EncodeInfoEnd).Find("Cars Models")
If EncodeCar.Offset(0, 1) = True Then
FinalData(3) = EncodeDecode.Base64EncodeString(CarModel)
Else
FinalData(3) = CarModel
End If
'writing down the data
For NbExec = 1 To Worksheets(MenuSheet).Range(NbLabelPos & Content.Row).Value
For Each data In FinalData
Worksheets(PrintSheet).Range(ColExit & LineExit + FirstLineData).Value = data
ColExit = Split(Cells(1, Range(ColExit & 1).Column + 1).Address, "$")(1)
Next
If ColExit = Split(Cells(1, 1 + UBound(FinalData)).Address, "$")(1) And NbExec < Worksheets(MenuSheet).Range(NbLabelPos & Content.Row).Value Then
ColExit = "A"
LineExit = LineExit + 1
End If
Next
LineExit = LineExit + 1
ColExit = "A"
End If
Next
End If
Next
End If
Next
The big problem with that is that when someone wants to print a label with no dealer, but just the content, the first "if statement" blocks everything, so, there is nothing to print...
I've started to code it in another way, through some "select case", but we will probably add some columns to this file, and with only these 3 data (Content + Nb are together) I already have 8 cases... I guess you know how fast this can go if we add a few columns. That's not possible to do.
*I have no idea what kind of solution would exist to answer my problem? I don't even know what to write on a search engine to try to have an answer :/ *
Here is the select case code (not finished as it's useless to continue) :
Select Case DealerChkBx 'Dealer
Case Is = 0 'Dealer
Select Case FTINbChkBx 'FTI
Case Is = 0 'FTI
Select Case CarsChkBx 'Cars
Case Is = 0 'Cars 0 0 0
pouet = MsgBox("At least one checkbox should be checked...", vbOKOnly, "Nothing...")
Case Is > 0 'Cars 0 0 1
For Each CarModel In Worksheets(MenuSheet).Range(CarsModelsPos & FirstLine + 1 & ":" & CarsModelsPos & CarsModelsEnd) 'for each car
If Worksheets(MenuSheet).Range(CarModel.Address).Offset(0, 1).Value = True Then 'if the corresponding checkbox is checked
If EncodeCar.Offset(0, 1) = True Then
OneMoreCar = OneMoreCar + 1
ReDim Preserve FinalData(LBound(FinalData) To UBound(FinalData), 1 To CarsChkBx)
FinalData(4, OneMoreCar) = EncodeDecode.Base64EncodeString(CarModel)
Else
OneMoreCar = OneMoreCar + 1
ReDim Preserve FinalData(LBound(FinalData) To UBound(FinalData), 1 To OneMoreCar)
FinalData(4, OneMoreCar) = CarModel
End If
End If
Next
End Select
Case Is > 0 'FTI
Select Case CarsChkBx 'Cars
Case Is = 0 'Cars 0 1 0
For Each FTINb In Worksheets(MenuSheet).Range(FTINbPos & FirstLine + 1 & ":" & FTINbPos & FTIContentEnd) 'for each car
If Worksheets(MenuSheet).Range(FTINb.Address).Offset(0, 1).Value = True Then 'if the corresponding checkbox is checked
'If Worksheets(MenuSheet).Range(CarsModelsPos & FirstLine).Value = True Then 'if it is to be printed
If EncodeCar.Offset(0, 1) = True Then
OneMoreFTI = OneMoreFTI + 1
ReDim Preserve FinalData(LBound(FinalData) To UBound(FinalData), 1 To FTINbChkBx)
FinalData(2, OneMoreFTI) = EncodeDecode.Base64EncodeString(FTINb.Offset(0, -1).Value)
FinalData(3, OneMoreFTI) = EncodeDecode.Base64EncodeString(FTINb)
Else
OneMoreFTI = OneMoreFTI + 1
ReDim Preserve FinalData(LBound(FinalData) To UBound(FinalData), 1 To FTINbChkBx)
FinalData(2, OneMoreFTI) = FTINb.Offset(0, -1).Value
FinalData(3, OneMoreFTI) = FTINb
End If
End If
Next
Case Is > 0 'Cars 0 1 1
End Select
End Select
Case Is > 0 'Dealer
Select Case FTINbChkBx 'FTI
Case Is = 0 'FTI
Select Case CarsChkBx 'Cars
Case Is = 0 'Cars 1 0 0
For Each Dealer In Worksheets(MenuSheet).Range(DealerPos & FirstLine + 1 & ":" & DealerPos & DealerEnd) 'for each car
If Worksheets(MenuSheet).Range(Dealer.Address).Offset(0, 1).Value = True Then 'if the corresponding checkbox is checked
'If Worksheets(MenuSheet).Range(CarsModelsPos & FirstLine).Value = True Then 'if it is to be printed
If EncodeDealer.Offset(0, 1) = True Then
OneMoreDealer = OneMoreDealer + 1
ReDim Preserve FinalData(LBound(FinalData) To UBound(FinalData), 1 To DealerChkBx)
FinalData(1, OneMoreDealer) = EncodeDecode.Base64EncodeString(Dealer)
Else
OneMoreDealer = OneMoreDealer + 1
ReDim Preserve FinalData(LBound(FinalData) To UBound(FinalData), 1 To DealerChkBx)
FinalData(1, OneMoreDealer) = Dealer
End If
End If
Next
Case Is > 0 'Cars 1 0 1
End Select
Case Is > 0 'FTI
Select Case CarsChkBx 'Cars
Case Is = 0 'Cars 1 1 0
Case Is > 0 'Cars 1 1 1
End Select
End Select
End Select
Hoping my request is understandable, thank you all by advance !
Solution
Ok, I think I got a solution, dirty one, but working... I used the "GoTo Label" function and variables counting the number of checkboxes checked this way :
if NbDealer = 0 then
GoTo NoDealer
End if
for each dealer
if checkbox checked
Write dealer in the 1st position of the dataarray
NoDealer :
if NbContent = 0 then
GoTo NoContent
End if
for each Content
if checkbox checked
write content in the 2nd position of the dataarray
write Nb in 3rd position of the dataarray
NoContent:
if NbCars = 0 then
GoTo NoCars
End if
for each CarModel
if checkbox checked
write car model in the 4th position of the dataarray
NoCars:
For Each data In datarray
print that in the required column in the print sheet
Next
End If
if NbCars = 0 then 'just to avoid passing on the "Next" of the non initialized For loop
GoTo EndCars
End if
Next
EndCars:
End If
if NbContent = 0 then
GoTo EndContent
End if
Next
EndContent:
End If
if NbDealer = 0 then
GoTo EndDealer
End if
Next
EndDealers:
- How to make Colors Mixer in vba
- How to get HEX color value from cell color?
- SSIS: Insert multiple Excel files with same format but different file name to multiple database table destinations based on the Excel filename
- How to randomize Excel rows
- VLOOKUP Returns 0 even though there is a value in the line below the first result
- transpose a table with multiple values in excel
- Trying to late bind outlook to but getting type mismatch error after create object line
- Power Query Transform a Column based on Another Column
- Apply FILTER formula to array (and use filter criteria on specific column in the array)
- Bitly API call using VBA Excel Macro
- excel vba projects not closing
- In a standard MS Access SQL query output that does not have any aliases, how do I replace the full names by their "first-letters" aliases?
- Sigma or Summation function in Excel
- Problem getting the value from a cell using M in excel
- INDEX MATCH to also pull through notes
- Move formatted data in selection from Excel into Word tables
- Excel VBA function to remove letters at end of string
- Can't get all excel processes to stop when closing through Powershell
- Excel function to construct an array from values without VBA
- Alternative method to delete file with out having to add MS Scripting Runtime Reference
- Add new button to worksheet with Excel Add-in
- Apply outline border only to range of cells with openpyxl
- How to Separate Data with Inconsistent Patterns into a Structured Format in Excel
- Excel - Aggregate dynamically values in a Table using array formulas (MAP, BYROW, CHOOSECOLS, TEXTJOIN, LAMBDA, FILTER, HSTACK) in a single Cell
- How to reference the current User\Desktop location in VBA
- Powerpoint chart to excel relative link
- EXCEL: How do I return multiple columns using XLOOKUP, when the lookup_value is a range?
- VBA: How to Loop IF Statement through a Cell and Chart Series
- Incorporating Checkbox to lines of code rather than Cell value
- How do I remove a character from a column of data in Excel