VBA MACRO Combobox is limited in data - excel

I have a script in VBA (downloaded from internet and adjusted to my use). It is for Data Entry. But i have the problem with some Comboboxes. It is not alowing me to see the whole list of choises. It only shows 2 values instead of the 128 values.
I have tried to put it in a different column but still the same. At this moment C_06.List = [bom].Value is my problem!
Option Explicit
Dim Rng As Range, fnd As Range
Dim Ctrl As Control
Dim iRow As Integer
Dim wsAE As Worksheet
Private Sub C_02_Click()
T_ARR.Value = C_02.Column(1)
T_RENOV.Value = C_02.Column(3)
T_FINC.Value = C_02.Column(4)
T_AREA.Value = C_02.Column(9)
T_CALLE.Value = C_02.Column(11)
T_DIAS.Value = C_02.Column(12)
T_ESTATUS.Value = C_02.Column(13)
T_SUELO.Value = C_02.Column(15)
T_COLONIA.Value = C_02.Column(16)
T_CP.Value = C_02.Column(14)
T_ESTADO.Value = C_02.Column(17)
T_M2.Value = C_02.Column(20)
End Sub
Private Sub CMB_addnew_Click()
Set wsAE = Worksheets("INGRESOS")
If MsgBox("Correct entry?", vbYesNo + vbQuestion, "Check the data!") = vbNo Then Exit Sub
iRow = wsAE.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
wsAE.Cells(iRow, 1).Resize(, 25).Value = Array(T_id.Value, C_02.Value, T_AREA.Value, T_ARR.Value, T_DATE.Value, C_CONC.Value, T_REFBANC.Value, T_PROYECTO.Value, T_CARGO.Value, T_RAD.Value, T_NRAD.Value, T_NPAGO.Value, C_METH.Value, T_RENOV.Value, T_FINC.Value, _
T_DIAS.Value, T_PAGARFEC.Value, T_SUELO.Value, T_ESTATUS.Value, T_M2.Value, T_CALLE.Value, T_COLONIA.Value, T_ESTADO.Value, T_CP.Value, _
, T_NOTA.Value)
'Columns.AutoFit
MsgBox "The new entry has been saved.", vbInformation, "Done"
For Each Ctrl In Controls
If TypeName(Ctrl) = "TextBox" Or TypeName(Ctrl) = "ComboBox" Then Ctrl.Value = ""
Next Ctrl
LB_01.ListIndex = -1
LB_01.TopIndex = 0
Call UserForm_Initialize
End Sub
Private Sub CMB_clear_Click()
For Each Ctrl In Controls
If TypeName(Ctrl) = "TextBox" Or TypeName(Ctrl) = "ComboBox" Then Ctrl.Value = ""
Next Ctrl
LB_01.ListIndex = -1
LB_01.TopIndex = 0
Call UserForm_Initialize
End Sub
Private Sub CMB_close_Click()
Unload Me
End Sub
Private Sub LB_01_Click()
T_id.Value = LB_01.Column(0)
C_02.Value = LB_01.Column(1)
T_ARR.Value = LB_01.Column(2)
T_CARGO.Value = LB_01.Column(3)
T_RENOV.Value = LB_01.Column(4)
T_FINC.Value = LB_01.Column(5)
C_METH.Value = LB_01.Column(6)
C_EMPTY.Value = LB_01.Column(7)
C_CONC.Value = LB_01.Column(8)
T_NRAD.Value = LB_01.Column(9)
T_NOTA.Value = LB_01.Column(10)
T_DIAS.Value = LB_01.Column(11)
T_PAGARFEC.Value = LB_01.Column(12)
T_NPAGO.Value = LB_01.Column(13)
C_06.Value = LB_01.Column(14)
C_BOM.Value = LB_01.Column(15)
T_CP.Value = LB_01.Column(16)
T_ESTADO.Value = LB_01.Column(17)
T_DATE.Value = LB_01.Column(18)
T_PROYECTO.Value = LB_01.Column(19)
T_RAD.Value = LB_01.Column(20)
T_AREA.Value = LB_01.Column(21)
T_CALLE.Value = LB_01.Column(22)
T_ESTATUS.Value = LB_01.Column(23)
T_SUELO.Value = LB_01.Column(24)
T_COLONIA.Value = LB_01.Column(25)
End Sub
Private Sub UserForm_Initialize()
T_id.Value = WorksheetFunction.Max([ids]) + 1
LB_01.List = [database].Value
C_02.List = [datalist].Value
C_CONC.List = [nouns].Value
C_BOM.List = [mrp].Value
C_METH.List = [BUoM].Value
C_06.List = [bom].Value
T_DATE.Value = Now
End Sub

Related

Excel Visual Basic SpinButton1 does not work on second search

I have a table with name and age and a command button, this button opens the customer search screen. When I search for the name Andrew brings me 3 results, I go to page 3 of 3 and perform a new search, so the arrow doesn't work, do you know where the error might be?
Public MatrizResultados As Variant
Public Total_Ocorrencias As Long
Private Sub btn_Procurar_Click()
If Me.txt_Procurar.Text = "" Then
MsgBox "Enter a name"
Else
Call ProcuraPersonalizada(Me.txt_Procurar.Text)
End If
End Sub
Private Sub Label6_Click()
End Sub
Private Sub Label7_Click()
End Sub
Private Sub SpinButton1_Change()
Dim Linha As Long
Dim TotalOcorrencias As Long
TotalOcorrencias = SpinButton1.Max + 1
Linha = MatrizResultados(SpinButton1.Value)
Label_Registros_Contador.Caption = SpinButton1.Value + 1 & " de " & TotalOcorrencias
TextBox1.Text = Plan1.Cells(Linha, 1).Value
TextBox2.Text = Plan1.Cells(Linha, 2).Value
End Sub
Private Sub ProcuraPersonalizada(ByVal TermoPesquisado As String)
Dim Busca As Range
Dim Primeira_Ocorrencia As String
Dim Resultados As String
'perform the search
Set Busca = Plan1.Cells.Find(What:=TermoPesquisado, After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not Busca Is Nothing Then
Primeira_Ocorrencia = Busca.Address
Resultados = Busca.Row
Do
Set Busca = Plan1.Cells.FindNext(After:=Busca)
If Not Busca.Address Like Primeira_Ocorrencia Then
Resultados = Resultados & ";" & Busca.Row
End If
Loop Until Busca.Address Like Primeira_Ocorrencia
MatrizResultados = Split(Resultados, ";")
SpinButton1.Max = UBound(MatrizResultados)
SpinButton1.Enabled = True
Label_Registros_Contador.Caption = "1 de " & UBound(MatrizResultados) + 1
TextBox1.Text = Plan1.Cells(MatrizResultados(0), 1).Value
TextBox2.Text = Plan1.Cells(MatrizResultados(0), 2).Value
Else
SpinButton1.Enabled = False
Label_Registros_Contador.Caption = ""
TextBox1.Text = ""
TextBox2.Text = ""
MsgBox "No results for '" & TermoPesquisado & "' was found."
End If
txt_Procurar.Text = ""
txt_Procurar.SetFocus
End Sub
Private Sub TextBox2_Change()
End Sub
Private Sub UserForm_Initialize()
SpinButton1.Enabled = False
Label_Registros_Contador.Caption = ""
End Sub
You just need to reset the Spin button, it thinks its still on entry 3 of 3 (you can reverse through the options and then it will be correct when you try and go forwards again).
Add this line:
SpinButton1.Value = 0
Somewhere before you start messing with it, I put it:
MatrizResultados = Split(Resultados, ";")
SpinButton1.Value = 0
SpinButton1.Max = UBound(MatrizResultados)

How to retrieve check of checkbox after clicking listbox_click() in Excel VBA?

What it would like to happen, when listbox is click it would retrieve the check of checkbox from the worksheet.
Private Sub ListBox1_Click()
Dim say, lastrow As Long
TextBox15 = ListBox1.Column(0)
TextBox18 = ListBox1.Column(1)
TextBox1 = ListBox1.Column(2)
TextBox2 = ListBox1.Column(3)
TextBox19 = ListBox1.Column(4)
TextBox3 = ListBox1.Column(5)
TextBox24 = ListBox1.Column(6)
TextBox26 = ListBox1.Column(7)
TextBox5 = ListBox1.Column(8)
TextBox6 = ListBox1.Column(9)
TextBox7 = ListBox1.Column(10)
TextBox8 = ListBox1.Column(11)
TextBox23 = ListBox1.Column(12)
TextBox22 = ListBox1.Column(13)
TextBox4 = ListBox1.Column(14)
TextBox21 = ListBox1.Column(15)
TextBox20 = ListBox1.Column(16)
TextBox11 = ListBox1.Column(17)
TextBox12 = ListBox1.Column(18)
TextBox13 = ListBox1.Column(19)
TextBox14 = ListBox1.Column(20)
TextBox27 = ListBox1.Column(21)
TextBox28 = ListBox1.Column(22)
TextBox29 = ListBox1.Column(23)
TextBox25 = ListBox1.Column(24)
TextBox30 = ListBox1.Column(25)
TextBox31 = ListBox1.Column(26)
TextBox32 = ListBox1.Column(27)
TextBox33 = ListBox1.Column(28)
CheckBox1 = ListBox1.Column(29)
CheckBox2 = ListBox1.Column(30)
CheckBox3 = ListBox1.Column(31)
CheckBox4 = ListBox1.Column(32)
CheckBox5 = ListBox1.Column(33)
CheckBox6 = ListBox1.Column(34)
CheckBox7 = ListBox1.Column(35)
CheckBox8 = ListBox1.Column(36)
CheckBox9 = ListBox1.Column(37)
CheckBox10 = ListBox1.Column(38)
CheckBox11 = ListBox1.Column(39)
CheckBox12 = ListBox1.Column(40)
CheckBox13 = ListBox1.Column(41)
lastrow = Sheets("liste").Cells(Rows.Count, "D").End(xlUp).Row
Set sonsati = Sheets("liste").Range("D2:D" & lastrow).Find(What:=TextBox1.Text, LookIn:=xlValues, LookAt:=xlWhole)
say = sonsati.Row
Sheets("liste").Range("A" & say & ":AD" & say).Select
CommandButton1.Enabled = False
CommandButton2.Enabled = True
CommandButton3.Enabled = True
End Sub
I tried the code above but I am always prompted with an error of
"Run-time error '-2147024809', could not get the column property. Invalid argument.
in the listbox, it shows as True / False. – Crusin18 1 hour ago
You are strying to assign a String to a Boolean. Convert it to Boolean first and then try it. For example
CheckBox6.Value = CBool(ListBox1.Column(x))
CBool("True") will return Boolean True and CBool("False") will return Boolean False. If you think there can be spaces then try this
CheckBox6.Value = CBool(Trim(ListBox1.Column(x)))

Insert TextBox value into first empty cell in column

I have the following code which works fine. (TextBoxes are on "UserForm" in Excel VBA, and executes with clicking CommandButton1 on that UserForm.) But can anyone help me to insert the value of each TextBox into the first empty cell in Column M? This way inserts empty rows. I will use this in several workbooks, so using "ActiveSheet" is easiest for me.
Sub UserForm_Initialize()
Me.TextBox1.Value = CStr(ActiveSheet.Range("M1").Value)
Me.TextBox2.Value = CStr(ActiveSheet.Range("M2").Value)
Me.TextBox3.Value = CStr(ActiveSheet.Range("M3").Value)
Me.TextBox4.Value = CStr(ActiveSheet.Range("M4").Value)
Me.TextBox5.Value = CStr(ActiveSheet.Range("M5").Value)
Me.TextBox6.Value = CStr(ActiveSheet.Range("M6").Value)
Me.TextBox7.Value = CStr(ActiveSheet.Range("M7").Value)
Me.TextBox8.Value = CStr(ActiveSheet.Range("M8").Value)
Me.TextBox9.Value = CStr(ActiveSheet.Range("M9").Value)
Me.TextBox10.Value = CStr(ActiveSheet.Range("M10").Value)
Me.TextBox11.Value = CStr(ActiveSheet.Range("M11").Value)
Me.TextBox12.Value = CStr(ActiveSheet.Range("M12").Value)
Me.TextBox13.Value = CStr(ActiveSheet.Range("M13").Value)
Me.TextBox14.Value = CStr(ActiveSheet.Range("M14").Value)
Me.TextBox15.Value = CStr(ActiveSheet.Range("M15").Value)
Me.TextBox16.Value = CStr(ActiveSheet.Range("M16").Value)
Me.TextBox17.Value = CStr(ActiveSheet.Range("M17").Value)
Me.TextBox18.Value = CStr(ActiveSheet.Range("M18").Value)
Me.TextBox19.Value = CStr(ActiveSheet.Range("M19").Value)
Me.TextBox20.Value = CStr(ActiveSheet.Range("M20").Value)
Me.TextBox21.Value = CStr(ActiveSheet.Range("M21").Value)
Me.TextBox22.Value = CStr(ActiveSheet.Range("M22").Value)
End Sub
'Insert Button
Private Sub CommandButton1_Click()
Range("M1") = Me.TextBox1.Text
Range("M2") = Me.TextBox2.Text
Range("M3") = Me.TextBox3.Text
Range("M4") = Me.TextBox4.Text
Range("M5") = Me.TextBox5.Text
Range("M6") = Me.TextBox6.Text
Range("M7") = Me.TextBox7.Text
Range("M8") = Me.TextBox8.Text
Range("M9") = Me.TextBox9.Text
Range("M10") = Me.TextBox10.Text
Range("M11") = Me.TextBox11.Text
Range("M12") = Me.TextBox12.Text
Range("M13") = Me.TextBox13.Text
Range("M14") = Me.TextBox14.Text
Range("M15") = Me.TextBox15.Text
Range("M16") = Me.TextBox16.Text
Range("M17") = Me.TextBox17.Text
Range("M18") = Me.TextBox18.Text
Range("M19") = Me.TextBox19.Text
Range("M20") = Me.TextBox20.Text
Range("M21") = Me.TextBox21.Text
Range("M22") = Me.TextBox22.Text
Range("A25").Value = "Hide"
Unload Me
End Sub
Sub CommandButton2_Click()
'Cancel button
Unload Me
End Sub
EDIT: last guess
You can do something like this:
Private Sub CommandButton1_Click()
Dim i As Long, c As Range
ActiveSheet.Range("M1:M22").ClearContents
Set c = ActiveSheet.Range("M1")
For i = 1 to 22
c.Value = Me.Controls("TextBox" & i).Text
If Len(c.Value) > 0 then Set c = c.offset(1, 0)
Next i
Unload Me
End Sub

How to add optional checkboxes based on the selection in excel VBA

I'm writing a Userform
What I am trying to achieve: while running my Userform with multiple selection checkboxes.
Collect all checked checkboxes captions along with its parent frame name
Filtering database on its first column with those collected strings
Loop through filtered cells and make the wanted sums
The selection can contain each row with different columns (Based on checkbox selection)
Coded for Estimate command button:
Private Sub preflight_calculate_Click()
Dim preflight_resource As Double, preflight_time As Double
preflight_resource = Val(Me.preflight_resource)
preflight_time = Val(Me.preflight_time)
Dim cell As Range
With ThisWorkbook.Sheets("Preflight")
With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
.AutoFilter 1, Criteria1:=GetCheckedCaptions, Operator:=xlFilterValues
For Each cell In .SpecialCells(xlCellTypeVisible)
preflight_resource = preflight_resource + cell.Offset(, 6).Value
preflight_time = preflight_time + cell.Offset(, 8).Value
Next
End With
.AutoFilterMode = False
End With
With Me
.preflight_resource.Text = preflight_resource
.preflight_time.Text = preflight_time
End With
End Sub
Function GetCheckedCaptions() As Variant
Dim ctl As Control
With Me
For Each ctl In .Controls
If TypeName(ctl) = "CheckBox" Then
If ctl.Value Then
GetCheckedCaptions = GetCheckedCaptions & " " & ctl.Parent.Caption & "-" & ctl.Caption
End If
End If
Next
End With
GetCheckedCaptions = Split(Trim(GetCheckedCaptions))
End Function
Error code line:
preflight_resource = preflight_resource + cell.Offset(, 6).Value
Expected result:
For Example:
If I select the checkbox as follows US -> Mobile -> P0 and US -> Desktop -> P1
Output should be:
Textboxes below:
Resource Utilized: (F2 + G3) -> (0.73 + 0.62) -> 1.35 (Inside text box)
Time in Hours: (H2 + I3) -> (5.87 + 4.95) -> 10.82 (Inside text box)
How to achieve this?
I have a different approach to solve your question's problem.
If having a separate columns to store the values of each selection is an option, then check it out.
Summary of what happens in the spreadsheet:
Checkboxes data will be stored by VBA code in columns L to O
Cells L25 and N25 will sum total resources and time by adding the formulas (in each cell)
L25 -> =SUM(L2:M23)
N25 -> =SUM(N2:O23)
Here you can download the current file: https://1drv.ms/x/s!ArAKssDW3T7wlKMfhNyjEDsHmkxz-g
This will be the setup
The code behind the userform is as follows. Customize it reading each comment:
Option Explicit
Private Sub knightregression_yes_Change()
Application.EnableEvents = False
' Record values according to checkboxes checked in form
mUserForm.RecordCheckboxChange Me, Me.knightregression_yes, "Mobile", "Knight regression" ' In this case the task title is specified (last sub argument)
Application.EnableEvents = True
End Sub
Private Sub preflight_no_Click()
Application.EnableEvents = False
' Set userform's controls values depending on which one is calling the function
SetUserFormControlsValues Me, Me.preflight_no
Application.EnableEvents = True
End Sub
Private Sub preflight_yes_Click()
Application.EnableEvents = False
' Set userform's controls values depending on which one is calling the function
SetUserFormControlsValues Me, Me.preflight_yes
Application.EnableEvents = True
End Sub
Private Sub us_desktop_Change()
Application.EnableEvents = False
' Set userform's controls values depending on which one is calling the function
SetUserFormControlsValues Me, Me.us_desktop
Application.EnableEvents = True
End Sub
Private Sub us_dp0_Change()
Application.EnableEvents = False
' Record values according to checkboxes checked in form
mUserForm.RecordCheckboxChange Me, Me.us_dp0, "Desktop"
Application.EnableEvents = True
End Sub
Private Sub us_mobile_Change()
Application.EnableEvents = False
' Set userform's controls values depending on which one is calling the function
SetUserFormControlsValues Me, Me.us_mobile
Application.EnableEvents = True
End Sub
Private Sub us_mp0_Change()
Application.EnableEvents = False
' Record values according to checkboxes checked in form
mUserForm.RecordCheckboxChange Me, Me.us_mp0, "Mobile"
Application.EnableEvents = True
End Sub
Private Sub us_mp1_Change()
Application.EnableEvents = False
' Record values according to checkboxes checked in form
mUserForm.RecordCheckboxChange Me, Me.us_mp1, "Mobile"
Application.EnableEvents = True
End Sub
Private Sub us_mp2_Change()
Application.EnableEvents = False
' Record values according to checkboxes checked in form
mUserForm.RecordCheckboxChange Me, Me.us_mp2, "Mobile"
Application.EnableEvents = True
End Sub
Private Sub us_yes_Change()
Application.EnableEvents = False
' Set userform's controls values depending on which one is calling the function
SetUserFormControlsValues Me, Me.us_yes
Application.EnableEvents = True
End Sub
Private Sub UserForm_Initialize()
Dim formControl As MSForms.Control
' Clear preflight selections
ThisWorkbook.Worksheets("Preflight").Range("L2:O32").ClearContents
' Make all checkboxes unchecked and disabled except preflight test
For Each formControl In Me.Controls
If TypeOf formControl Is MSForms.CheckBox Then
If InStr(formControl.Name, "preflight") = 0 Then
formControl.Value = False
formControl.Enabled = False
End If
End If
Next
' Empty resource and time textboxes
Me.preflight_resource = vbNullString
Me.preflight_time = vbNullString
End Sub
Private Sub ComboBox2_Change()
Dim index As Integer
index = ComboBox2.ListIndex
lstAll.Clear
lstAll.MultiSelect = 2
lst_Added.MultiSelect = 2
Select Case index
Case Is = 0
With lstAll
Dim i As Long, LastRow As Long
LastRow = Sheets("Report").Range("A" & Rows.Count).End(xlUp).Row
If Me.lstAll.ListCount = 0 Then
For i = 2 To LastRow
Me.lstAll.AddItem Sheets("Report").Cells(i, "A").Value
Next i
End If
End With
Case Is = 1
With lstAll
.AddItem "No Task"
End With
Case Is = 2
With lstAll
.AddItem "No Task"
End With
End Select
End Sub
Private Sub Newfeatureyes_Click()
lstAll.MultiSelect = 2
lst_Added.MultiSelect = 2
Dim i As Long, LastRow As Long
LastRow = Sheets("NewFeature").Range("A" & Rows.Count).End(xlUp).Row
If Me.lstAll.ListCount = 0 Then
For i = 2 To LastRow
Me.lstAll.AddItem Sheets("NewFeature").Cells(i, "A").Value
Next i
End If
End Sub
Private Sub Newfeatureno_Click()
lstAll.Clear
lst_Added.Clear
mobileutilize = ""
mobilehours = ""
desktoputilize = ""
desktophours = ""
End Sub
Private Sub submitmobile_Click()
Dim i As Long, j As Long, LastRow As Long
Dim lbValue As String
Dim ws As Worksheet
If lst_Added.ListCount = 0 Then
MsgBox "Please add atleast 1 task"
Exit Sub
End If
mobileutilize = ""
mobilehours = ""
Set ws = ThisWorkbook.Sheets("NewFeature")
With ws
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
For j = 0 To lst_Added.ListCount - 1
lbValue = lst_Added.List(j)
If .Cells(i, "A").Value = lbValue Or _
.Cells(i, "A").Value = Val(lbValue) Then
mobileutilize = Val(mobileutilize) + Val(.Cells(i, "F").Value)
mobilehours = Val(mobilehours) + Val(.Cells(i, "H").Value)
End If
Next
Next
End With
End Sub
Private Sub submitdesktop_Click()
Dim i As Long, j As Long, LastRow As Long
Dim lbValue As String
Dim ws As Worksheet
If lst_Added.ListCount = 0 Then
MsgBox "Please add atleast 1 task"
Exit Sub
End If
desktoputilize = ""
desktophours = ""
Set ws = ThisWorkbook.Sheets("NewFeature")
With ws
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
For j = 0 To lst_Added.ListCount - 1
lbValue = lst_Added.List(j)
If .Cells(i, "A").Value = lbValue Or _
.Cells(i, "A").Value = Val(lbValue) Then
desktoputilize = Val(desktoputilize) + Val(.Cells(i, "G").Value)
desktophours = Val(desktophours) + Val(.Cells(i, "I").Value)
End If
Next
Next
End With
End Sub
Private Sub cmdAdd_Click()
If lstAll.ListCount = 0 Then
MsgBox "Select an item"
Exit Sub
End If
Dim i As Integer
For i = 0 To lstAll.ListCount - 1
If lstAll.Selected(i) = True Then lst_Added.AddItem lstAll.List(i)
Next i
End Sub
Private Sub cmdRemove_Click()
If lstAll.ListCount = 0 Then
MsgBox "Select an item"
Exit Sub
End If
Dim counter As Integer
counter = 0
For i = 0 To lst_Added.ListCount - 1
If lst_Added.Selected(i - counter) Then
lst_Added.RemoveItem (i - counter)
counter = counter + 1
End If
Next i
End Sub
Private Sub CommandButton1_Click()
Unload Me
Sheets("Estimation form").Select
Range("A1").Select
End Sub
Private Sub ComboBox1_DropButtonClick()
Dim i As Long, LastRow As Long
LastRow = Sheets("Report").Range("A" & Rows.Count).End(xlUp).Row
If Me.ComboBox1.ListCount = 0 Then
For i = 2 To LastRow
Me.ComboBox1.AddItem Sheets("Report").Cells(i, "A").Value
Next i
End If
End Sub
Also, add a module, name it: mUserForm and add this code:
Option Explicit
' Set userform's controls values depending on which one is calling the function
Public Sub SetUserFormControlsValues(mainUserForm As UserForm1, sourceControl As MSForms.Control)
Dim formControl As MSForms.Control
Dim enableMainCheckBoxes As Boolean
Dim enableMobileCheckBoxes As Boolean
Dim enableDesktopCheckBoxes As Boolean
Dim enableMPCheckboxes As Boolean
Dim enableDPCheckboxes As Boolean
Dim countryCode As String
Dim subcontrolList() As String
Dim counter As Integer
Select Case sourceControl.Name
' If preflight yes or no
Case "preflight_yes"
enableMainCheckBoxes = True ' xx_yes
enableMobileCheckBoxes = False ' xx_mobile
enableDesktopCheckBoxes = False ' xx_desktop
enableMPCheckboxes = False ' xx_mpx
enableDPCheckboxes = False ' xx_dpx
subcontrolList = Split("yes", ",")
Case "preflight_no"
enableMainCheckBoxes = False ' xx_yes
enableMobileCheckBoxes = False ' xx_mobile
enableDesktopCheckBoxes = False ' xx_desktop
enableMPCheckboxes = False ' xx_mpx
enableDPCheckboxes = False ' xx_dpx
subcontrolList = Split("yes", ",")
' If main box yes
Case "us_yes", "uk_yes", "jp_yes", "de_yes", "es_yes", "it_yes", "fr_yes"
enableMainCheckBoxes = True ' xx_yes
enableMobileCheckBoxes = sourceControl.Value ' xx_mobile
enableDesktopCheckBoxes = sourceControl.Value ' xx_desktop
enableMPCheckboxes = False ' xx_mpx
enableDPCheckboxes = False ' xx_dpx
countryCode = Left(sourceControl.Name, InStr(sourceControl.Name, "_") - 1)
subcontrolList = Split("mobile,desktop", ",")
' If mobile yes
Case "us_mobile", "uk_mobile", "jp_mobile", "de_mobile", "es_mobile", "it_mobile", "fr_mobile"
enableMainCheckBoxes = True ' xx_yes
enableMobileCheckBoxes = True ' xx_mobile
enableDesktopCheckBoxes = True ' xx_desktop
enableMPCheckboxes = True ' xx_mpx
enableDPCheckboxes = False ' xx_dpx
countryCode = Left(sourceControl.Name, InStr(sourceControl.Name, "_") - 1)
subcontrolList = Split("mp", ",")
' if desktop yes
Case "us_desktop", "uk_desktop", "jp_desktop", "de_desktop", "es_desktop", "it_desktop", "fr_desktop"
enableMainCheckBoxes = True ' xx_yes
enableMobileCheckBoxes = True ' xx_mobile
enableDesktopCheckBoxes = True ' xx_desktop
enableMPCheckboxes = False ' xx_mpx
enableDPCheckboxes = True ' xx_dpx
countryCode = Left(sourceControl.Name, InStr(sourceControl.Name, "_") - 1)
subcontrolList = Split("dp", ",")
End Select
For Each formControl In mainUserForm.Controls
If TypeOf formControl Is MSForms.CheckBox Then
' Set sub controls value
For counter = 0 To UBound(subcontrolList)
If sourceControl.Name = "preflight_yes" And InStr(formControl.Name, "preflight") = 0 And InStr(formControl.Name, countryCode & "_" & subcontrolList(counter)) > 0 Then
formControl.Enabled = True
formControl.Value = False
ElseIf sourceControl.Name = "preflight_no" And InStr(formControl.Name, "preflight") = 0 And InStr(formControl.Name, countryCode & "_" & subcontrolList(counter)) > 0 Then
formControl.Enabled = False
formControl.Value = False
ElseIf InStr(formControl.Name, "preflight") = 0 And InStr(formControl.Name, countryCode & "_" & subcontrolList(counter)) > 0 Then
formControl.Enabled = sourceControl.Value
formControl.Value = False
End If
Next counter
End If
Next
mainUserForm.releasenote_yes.Value = False
mainUserForm.automationfail_yes.Value = False
mainUserForm.knightregression_yes.Value = False
mainUserForm.releasenote_yes.Enabled = True
mainUserForm.automationfail_yes.Enabled = True
mainUserForm.knightregression_yes.Enabled = True
' Empty resource and time textboxes
mainUserForm.preflight_resource = vbNullString
mainUserForm.preflight_time = vbNullString
End Sub
' Record values according to checkboxes checked in form
Public Sub RecordCheckboxChange(mainUserForm As UserForm1, checkBoxControl As MSForms.CheckBox, formType As String, Optional exactTaskTitle As String)
' Declare objects
Dim resultRange As Range
' Declare other variables
Dim parentCaption As String
Dim checkboxCaption As String
Dim taskTitle As String
Dim resourceValue As Double
Dim timeValue As Double
Dim resourceColumn As Integer
Dim timeColumn As Integer
' Reset find parameters
Application.FindFormat.Clear
' Define which column to sum based on formType
Select Case formType
Case "Mobile"
resourceColumn = 5
timeColumn = 7
Case "Desktop"
resourceColumn = 6
timeColumn = 8
End Select
' Store the captions (parent and checkbox)
parentCaption = checkBoxControl.Parent.Caption
checkboxCaption = checkBoxControl.Caption
' If task title comes from code inside checkbox event, use it
If exactTaskTitle <> vbNullString Then
taskTitle = exactTaskTitle
Else
taskTitle = parentCaption & "*" & checkboxCaption
End If
' Find the parent and checkbox caption (using wildcards it's more simple)
Set resultRange = Sheets("Preflight").Range("A2:A32").Find(taskTitle, Lookat:=xlPart)
' If checkbox is checked record value
If checkBoxControl.Value = True Then
resourceValue = resultRange.Offset(0, resourceColumn).Value
timeValue = resultRange.Offset(0, timeColumn).Value
Else
resourceValue = 0
timeValue = 0
End If
' Store the value in spreadsheet
resultRange.Offset(0, resourceColumn + 6).Value = resourceValue
resultRange.Offset(0, timeColumn + 6).Value = timeValue
' Update the textboxes with totals
mainUserForm.preflight_resource = ThisWorkbook.Worksheets("Preflight").Range("L35").Value
mainUserForm.preflight_time = ThisWorkbook.Worksheets("Preflight").Range("N35").Value
' Reset find parameters
Application.FindFormat.Clear
End Sub

Unload form after printing in Excel

In frmClothingPricer, when cmdPrint is pressed, frmPrint activates and is printed however many times asked for. I don't want 10+ frmPrint "active". How can I close frmPrint after each print loop? I have tried it on frmPrint "Unload Me" but that doesn't unload it either. ?? what am I missing?
Routine for printing
If Len(HowMany) = 0 Then
End
Else
Do Until i = HowMany
frmPrint.Show 'prints form on activation
i = i + 1
Unload frmPrint 'this isn't working = several forms are open
Loop
End If
frmPrint code
Private Sub UserForm_Initialize()
PrintMe
End Sub
Private Sub PrintMe()
lblPrintMonthCode.Caption = frmClothingPricer.MonthCode
lblPrintPricer.Caption = frmClothingPricer.Pricer
lblPrintCost.Caption = (frmClothingPricer.Cost * 100)
lblPrintDescription.Caption = frmClothingPricer.Description
lblPrintPrice.Caption = frmClothingPricer.Price
lblPrintItemNumber = frmClothingPricer.ItemNumber
frmPrint.PrintForm
'tried unload.me here with same results
End Sub
I solved it by keeping all the code except labels on the original form. The latest errors revolved around variables I messed up switching around. It now works perfectly (below):
form1
Public Price As Double
Public Percent As Double
Public Cost As Currency
Public Description As String
Public MonthCode As Integer
Public Pricer As String
Public ItemNumber As Double
Private Sub UserForm_Initialize()
Pricer = InputBox("Enter Your Pricer Number", vbOKOnly, "")
If Len(Pricer) = 0 Then 'Checking if Length of name is 0 characters
End
Else
End If
End Sub
Private Sub cmdSearch_Click()
Dim Response As Long
Dim NotFound As Integer
Dim arr As Variant
Dim i As Long
Dim str1 As String, str2 As String, str3 As String
lbxCost.BackColor = &H80000005
lbxCost.Locked = False
NotFound = 0
ActiveWorkbook.Sheets("Items").Activate
Response = Val("0" & Replace(txtItemNumber.Text, "-", ""))
ItemNumber = Response
If Response <> False Then
With ActiveSheet
arr = .Range("A2:D" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With
For i = 1 To UBound(arr)
If arr(i, 1) = Response Then
str1 = IIf(str1 = "", arr(i, 2), str1 & "|" & arr(i, 2))
str2 = IIf(str2 = "", arr(i, 3), str2 & "|" & arr(i, 3))
str3 = IIf(str3 = "", arr(i, 4), str3 & "|" & arr(i, 4))
End If
Next
If str1 = "" Then
MsgBox "Item Number Not Found!", vbExclamation
NotFound = 1
txtItemNumber.Text = ""
txtItemNumber.SetFocus
Else
Frame1.Visible = True
lbxDescription.List = Split(str1, "|")
lbxCost.List = Split(str2, "|")
ListBox3.List = Split(str3, "|")
End If
End If
lbxCost.ListIndex = 0
End Sub
Private Sub lbxCost_Click()
Frame2.Visible = True
End Sub
Private Sub lbxPercent_Click()
Frame3.Visible = True
lbxCost.BackColor = &H80000004
lbxCost.Locked = True
For x = 0 To lbxCost.ListCount - 1
If lbxCost.Selected(x) = True Then
Cost = lbxCost.List(x)
Description = lbxDescription.List(x)
End If
Next x
For y = 0 To lbxPercent.ListCount - 1
If lbxPercent.Selected(y) = True Then
Percent = lbxPercent.List(y)
End If
Next y
lblPrice.Caption = (Round(Cost * (1 + (Percent / 100)), 0)) - 0.01
Price = lblPrice.Caption
lblItemNumber.Caption = txtItemNumber.Text
lblDescription.Caption = Description
MonthCode = (Year(Now)) + (Month(Now)) - 1765
lblMonthCode.Caption = MonthCode
lblPricer.Caption = Pricer
cmdPrint.SetFocus
End Sub
Private Sub cmdPrint_Click()
Dim i As Integer
Dim Howmany As Double
Load frmPopup
Howmany = Val(txtQuantity.Text)
i = 1
Do Until i > Howmany
frmPopup.PrintForm
i = i + 1
Loop
lbxPercent.ListIndex = -1
Frame1.Visible = False
Frame2.Visible = False
Frame3.Visible = False
txtItemNumber.Text = ""
txtItemNumber.SetFocus
Unload frmPopup
End Sub
form2
Private Sub UserForm_Initialize()
lblPrintMonthCode.Caption = frmClothingPricer.MonthCode
lblPrintPricer.Caption = frmClothingPricer.Pricer
lblPrintCost.Caption = (frmClothingPricer.Cost * 100)
lblPrintDescription.Caption = frmClothingPricer.Description
lblPrintPrice.Caption = frmClothingPricer.Price
lblPrintItemNumber = frmClothingPricer.ItemNumber
End Sub

Resources