I am trying to create a tool with a userform where the user types a Model in a textbox and selects all the countries where this Model comes from in 10 possible checkboxes.
This information is transferred to "Country" Worksheet through command button.
My code places textbox value in column A and country name from checkbox label in column B.
The problem is that I have more than one country for the same model so I'm getting blank cells without matching Model.
E.g. "Type A" belongs to USA, Brazil, Sweden and Mexico, so I should have "Type A" copied four times along country names instead of just one.
Private sub Transfer()
Dim i As Long
Dim aCol As Range
Dim BS As Worksheet
Set aCol = Worksheets("Country").Range("A:A")
Set BS = Worksheets("Country")
For i = 1 To 10
With Me.Controls("CheckBox" & i)
If .Value Then
aCol.Cells(82, 2).End(xlUp).Offset(1, 0).Value = .Caption
End If
End With
Next i
Dim b As Integer
b = 1
Do Until BS.Range("A" & b).Value = ""
b = b + 1
end sub
With the code you shared and without major changes, I would suggest you to think about writing the info contained in the textbox within the loop of the checkboxes and right after the if. This way you will be adding the textbox text no matter what avoiding the blanks
If .Value Then
aCol.Cells(82, 1).End(xlUp).Offset(1, 0).Value = Me.Controls("TextBox1").Text
aCol.Cells(82, 2).End(xlUp).Offset(1, 0).Value = .Caption
End If
Let me know if that works, below the full code I used to replicate your issue:
Private Sub CommandButton1_Click()
Call Transfer
End Sub
Private Sub Transfer()
Dim i As Long
Dim aCol As Range
Dim BS As Worksheet
Set aCol = Worksheets("Country").Range("A:A")
Set BS = Worksheets("Country")
For i = 1 To 3
With Me.Controls("CheckBox" & i)
If .Value Then
aCol.Cells(82, 1).End(xlUp).Offset(1, 0).Value = Me.Controls("TextBox1").Text
aCol.Cells(82, 2).End(xlUp).Offset(1, 0).Value = .Caption
End If
End With
Next i
End Sub
How the form I did looks in VBA
How the results look like in the file
Related
sub copycolmns() **code for copying columns data along with header in another sheet name paste sheet**
Sheets("copysheet1").Columns(11).Copy Destination:=Sheets("paste").Columns(1)
Sheets("copysheet2").Range("A1:A20").Copy
Sheets("paste").Range("B1").PasteSpecial xlPastevalues
End Sub
Sub reconncilirecords() ** this function to reconcile records and color them green if matching**
Dim col1 As Range, col2 as Range,Prod1 as String, Prod2 as String
Set col1 = Sheets("paste").Columns("A")
Set col2 = Sheets("Paste").Columns("B")
lr = Sheets("paste").Columns("A:B").SpecialCells(xlCellTypeLastCell).Row
For r = 2 to lr
Prod1 = Cells(r, col1.Column).Value
Prod2 = Cells(r, col2.Column).Value
If Prod1 = Prod2 Then
Cells(r, col1.Column).Interior.Color = vbGreen
Cells(r, col2.Column).Interior.Color = vbGreen
Else
Cells(r, col1.Column).Interior.Color = vbRed
Cells(r, col2.Column).Interior.Color = vbRed
End If
Next r
End Sub
Sub Result() **function to display if marching or not matching with message box**
Dim wj as Wrokbook
Dim ws_data as worksheet
Dim rng_data as Range
Set wj = Activeworkbook
Set ws_data = ws.Sheets("paste")
Dim last_row as Long
last_row = ws_data.Cells(Rows.Count, "A").End(xlup).Row
Set rng_data = Range("A2:A" & last_row)
If rng_data.Interior.Color = RGB(0,255,0) then
Msgbox" details verfd and matching"
Else
Msbxo "Mismatch found"
End If
End Sub
is there any way to speed up this process as whenever i run reconcile data 2nd sub function macro is getting hanged. Is there any other way to dynamically copy from sheet1 and sheet2 and recocnile the data and apply message box to check for last row.
Building on my comment; this is a mock-up, so untested... should give an idea:
destWS.Columns(1).value = sourceWS1.columns(2).value
destWS.Columns(2).value = sourceWS2.columns(2).value
With destWS.Range("A1:B" & destLastRow)
.FormatConditions.Add Type:=xlExpression, Formula1:="=$A1=$B1"
With .FormatConditions(.FormatConditions.Count)
.SetFirstPriority
With .Interior
.Color = vbRed
End With
End With
End With
You will most likely want to use exact ranges, not columns, as it slows things down... a lot.
I need your help. It seems what I have written in code does not accomplish what I am trying to do here.
The objective would be to have 2 userform combo boxes one for the (floor) values which are manually added once [3,4,5] and the other combo boxes (offices) in which values are dynamically added based on the selection made in the floor selection box.
Let's say for example that if I chose the value [3] in my floor combo box that the office combo box would contain the following values:
A-01
A-02
A-03
A-04
A-05
A-06
A-07
A-08
I thought this code would work but it doesn't:
'Cells(row, col)
Private Sub floor_Change()
lRow = Sheets("Office Spaces").UsedRange.Rows.Count
With Sheets("Office Spaces")
For i = 2 To lRow
If .Cells(i, 1).Value = UserForm1.floor.Value Then
UserForm1.office.AddItem .Cells(i, 2).Value
End If
Next i
End With
End Sub
Here's what the data looks in my excel sheet:
'Cells(row, col)
Private Sub floor56_Change()
UserForm1.office.Clear
Dim sh
Dim rw
Set sh = Sheets("Office Spaces")
For Each rw In sh.Rows
If sh.Cells(rw.row, 1).Text = UserForm1.floor.Value Then
UserForm1.office.AddItem (sh.Cells(rw.row, 2).Value)
End If
Next rw
End Sub
or
Private Sub floor_Change()
If UserForm1.floor.Value <> "" Then
UserForm1.office.Clear
Dim ws
Set ws = ThisWorkbook.Worksheets("Office Spaces")
Dim rng
Set rng = ws.Range("A:A")
For Each cell In rng
If cell.Text = UserForm1.floor.Value Then
UserForm1.office.AddItem (cell.Offset(0, 1).Value)
End If
Next cell
End If
End Sub
Part 1: A combo box in sheet1 to dynamically list unique values from a column in sheet2 put it in the drop down list
Part 2: Display the related entries of sheet2 in sheet1 based on the combo box selection.
I have done the part 1 in a method call fillCombo and have called it under ComboBox1_DropButtonClick() and part 2 under the method ComboBox1_Change()
First time when i click dropdown arrow of combo box it lists the unique entries and on making the selection in it, the related entries are displayed in sheet1 and everything is fine.
During the next selection of dropdown arrow it goes to ComboBox1_DropButtonclick() method then ComboBox1_change() method, ComboBox1_change() method without the dropdown list appearing and me selecting
So it works correctly only in the first instance.
Can you please correct the error.
Private Sub ComboBox1_Change()
Dim sht2, sht1, a As Long, X As Long, i As Long
Dim Lastrow As Long
Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")
a = sht2.Cells(Rows.Count, 1).End(xlUp).Row
X = 8
Lastrow = sht1.Range("D" & Rows.Count).End(xlUp).Row
sht1.Range("G8:J" & Lastrow).Clear
For i = 2 To a
If sht2.Cells(i, 3).Value = "Payments" Then
sht2.Cells(i, "C").Resize(1, 4).Copy sht1.Cells(X, "G")
X = X + 1
End If
Next
sht1.Select
sht1.Cells(1, 1).Select
End Sub
Private Sub ComboBox1_DropButtonClick()
Call fillCombo
End Sub
Sub fillCombo()
Dim ws2 As Worksheet
Set ws2 = ThisWorkbook.Sheets("Sheet2")
Group = 3
firstTime = True
strValue = Sheet1.ComboBox1.Value
'last row
wsLR = ws2.Cells(Rows.Count, 1).End(xlUp).Row
'loop thru rows
For l = 2 To wsLR
If ws2.Cells(l, Group) <> "" And (InStr(uE, "|" & ws2.Cells(l, Group) & "|") = 0) Then
If firstTime = True Then
firstTime = False
uE = "|" & uE & ws2.Cells(l, Group) & "|"
Else
uE = uE & ws2.Cells(l, Group) & "|"
End If
End If
Next l
dropValues = Split(uE, "|")
Sheet1.ComboBox1.Clear
For Each cell In dropValues
If cell <> "" Then
Sheet1.ComboBox1.AddItem cell
End If
Next cell
Sheet1.ComboBox1.Value = strValue
End Sub
Good day guys I created a userform on excel with a combobox and a command button, the command button is for updating the data on the spread sheet based on the item selected on the combobox and a textbox with data, the problem is every time I click the command button it does not update the data, instead it goes to the next column and fill it in. and i want the data to be updated on the item selected
this is what I tried
Private Sub CommandButton6_Click()
Dim lrCD As Long
lrCD = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet2").Cells(lrCD + 1, "A").Value = ComboBox1.Text
Sheets("Sheet2").Cells(lrCD + 1, "B").Value = TextBox5.Text
Create your form as below:
Column A in Sheet2 contains unique values that will appear in your combobox.
This code sits within the form.
The UserForm_Initialize() event fires when you open the form and will populate the combobox with values.
The CommandButton6_Click event searches column A and places the text in textbox5 next to the selected value.
Private Sub UserForm_Initialize()
Dim lrCD As Long
'Populate ComboBox with values from column A on Sheet2.
With ThisWorkbook.Worksheets("Sheet2")
lrCD = .Range("A" & Rows.Count).End(xlUp).Row
Me.ComboBox1.RowSource = "'Sheet2'!" & .Range(.Cells(1, 1), .Cells(lrCD, 1)).Address
End With
End Sub
Private Sub CommandButton6_Click()
Dim rCell As Range
With ThisWorkbook.Worksheets("Sheet2")
'Look for the selected value in column A.
Set rCell = .Columns(1).Find( _
What:=Me.ComboBox1.Value, _
After:=.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole)
'If a value is found place the textbox value in the column next to it.
If Not rCell Is Nothing Then
rCell.Offset(, 1) = Me.TextBox5.Value
End If
End With
End Sub
hope u're well. Need an expert help after trying a lot without sucess, please.
I have a price list in Sheet1 with 3 columns:
Medical Procedure
Type
Value of Procedure
In a userform, I need to return in Textbox1 the value of the procedure based on the criteria selected in combobox1 (with values that can be found in Medical Procedure column in Sheet1) and the caption in label1 (wich alrealdy is populated with a value that can be encounter in the Type column in Sheet1).
I tried this found here in stackoverflow from the user B Hart (thanks, B Hart!), but I wasn't able to change it to return in a textbox as a numerical value (this vba insert the found value in a listbox instead). Another issue is that the criteria below is in two combobox. I need the two criterias to be in a combobox and another in a label.
Private Sub GetCondStrandValue()
Dim iRow As Long
Dim strValue As String
strValue = vbNullString
If Me.ComboBox1.Value = vbNullString Or Me.ComboBox2.Value = vbNullString Then Exit Sub
With Planilha1
For iRow = 2 To .Range("A65536").End(xlUp).Row
If StrComp(.Cells(iRow, 1).Value, Me.ComboBox1.Value, 1) = 0 And _
StrComp(.Cells(iRow, 2).Value, Me.ComboBox2.Value, 1) = 0 Then
strValue = .Cells(iRow, 3).Value
Exit For
End If
Next
End With
If strValue = vbNullString Then Exit Sub
With Me.ListBox1
'If you only want a single value in the listbox un-comment the .clear line
'Otherwise, values will continue to be added
'.Clear
.AddItem strValue
.Value = strValue
.SetFocus
End With
End Sub
Maybe something like this:
Private Sub combobox1_Change()
Dim lastRow As Integer
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Me
For r = 2 To lastRow
If Sheets("Sheet1").Cells(r, 1) = .ComboBox1.Value And Sheets("Sheet1").Cells(r, 2) = .Label1.Caption Then
.TextBox1.Text = Sheets("Sheet1").Cells(r, 3)
Exit For
End If
Next
End With
End Sub