I have a code that he selected data that I want ,but I want to show this data in a table and not ina MsgBox.
This is my code and I hope that someone can find a solution for me
Private Sub CommandButton1_Click()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim table1 As Range
Dim table2 As Range
Dim table1Rows As Integer
Dim table1Cols As Integer
Set ws1 = Worksheets("Feuil1")
Set ws2 = Worksheets("Feuil2")
Set table1 = ws1.Cells
Set table2 = ws2.Cells
table1Rows = ws1.UsedRange.Rows.Count
table1Cols = ws1.UsedRange.Columns.Count
For i = 1 To table1Rows
For j = 1 To table1Cols
If table1(i, 1).Value <> table2(i, 1).Value Then
MsgBox "Libellé : " & table1(i, 1) & ", du montant : " & table1(i, 3) & " est ajouté !"
End If
Next
Next
End Sub
What you need is ListBox. Create UserForm (e.g. Userform1) and listbox inside of it (e.g. Listbox1). Then you can put the data inside by this formula .AddItem function. Your loop will look like:
For i = 1 To table1Rows
For j = 1 To table1Cols
If table1(i, 1).Value <> table2(i, 1).Value Then
UserForm1.ListBox1.AddItem "Libellé : " & table1(i, 1) & ", du montant : " & table1(i, 3) & " est ajouté !"
End If
Next
Next
End Sub
UserForm1.Show
Related
In my VBA code below it searches for any cell for red to delete. The line is at
Dim colors_to_delete As String: colors_to_delete = "red"
What would I add to this code so it delete red and blue?
Sub collapse_columns()
Dim x As Integer
For x = 1 To 4
collapse_column x
Next
End Sub
Sub collapse_column(column_number As Integer)
Dim row As Long
Dim s As Worksheet
Dim last_row As Long
Set s = ActiveSheet ' work on the active sheet
'Set s = Worksheets("Sheet1") 'work on a specific sheet
last_row = s.Cells(s.Rows.Count, column_number).End(xlUp).row
Dim colors_to_delete As String: colors_to_delete = "red"
For row = last_row To 1 Step -1
If InStr(1, " " & s.Cells(row, column_number).Value & " ", " " & colors_to_delete & " ") > 0 Then
s.Cells(row, column_number).Delete xlUp
End If
Next row
End Sub
You could use an array of color names:
Sub collapse_column(column_number As Integer)
Dim row As Long
Dim s As Worksheet
Dim last_row As Long, clr, c as Range
Set s = ActiveSheet ' work on the active sheet
last_row = s.Cells(s.Rows.Count, column_number).End(xlUp).row
For row = last_row To 1 Step -1
Set c = s.Cells(row, column_number)
For Each clr in Array("red", "blue") '<< array to check against
If InStr(1, " " & c.Value & " ", " " & clr & " ") > 0 Then
c.Delete xlUp
Exit For 'stop checking
End If
Next clr
Next row
End Sub
I have two excel sheet ReportOld and ReportNew, what I want to check and make sure all the column herder from both sheets are matching name and in same order. Basically need to check there should not be any new column added or removed from last report.. bot are identical.
Till now I tried the code is:
Sub colLookup()
Dim ShtOne As Worksheet, ShtTwo As Worksheet
Dim shtOneHead As Range, shtTwoHead As Range
Dim headerOne As Range, headerTwo As Range
Dim x As Integer
Dim lastCol As Long
Set ShtOne = Sheets("ReportOld")
Set ShtTwo = Sheets("ReportNew")
lastCol = ShtOne.Cells(1, Columns.Count).End(xlToLeft).Column
Set shtOneHead = ShtOne.Range("A1", ShtOne.Cells(1, lastCol))
lastCol = ShtTwo.Cells(1, Columns.Count).End(xlToLeft).Column
Set shtTwoHead = ShtTwo.Range("A1", ShtTwo.Cells(1, lastCol))
For Each headerTwo In shtTwoHead
For Each headerOne In shtOneHead
If headerTwo.Value = headerOne.Value Then
Else
x = MsgBox("Headers are not matching in both sheets.")
MsgBox "value is:" & headerTwo.Value
Exit Sub
End If
Next headerOne
Next headerTwo
End Sub
Try this code. It counts the headings on both sheets and fills an array of headings from both sheets. Then it compares the headings one each sheet and displays a message if the headings don't match. It then compares the number of columns and if they don't match, another message is displayed...
Sub colLookup()
Dim ShtOne As Worksheet, ShtTwo As Worksheet
Dim shtOneHead As Range, shtTwoHead As Range
Dim headerOne As Range, headerTwo As Range
Dim x As Integer
Dim lastCol As Long
Set ShtOne = Sheets("ReportOld")
Set ShtTwo = Sheets("ReportNew")
lastCol = ShtOne.Cells(1, Columns.Count).End(xlToLeft).Column
Set shtOneHead = ShtOne.Range("A1", ShtOne.Cells(1, lastCol))
lastCol = ShtTwo.Cells(1, Columns.Count).End(xlToLeft).Column
Set shtTwoHead = ShtTwo.Range("A1", ShtTwo.Cells(1, lastCol))
For Each headerTwo In shtTwoHead
For Each headerOne In shtOneHead
If headerTwo.Value = headerOne.Value Then
Else
x = MsgBox("Headers are not matching in both sheets.")
MsgBox "value is:" & headerTwo.Value
Exit Sub
End If
Next headerOne
Next headerTwo
End Sub
Sub new_code()
Dim a As Integer
Dim b As Integer
Dim x As Integer
Dim HeadNew As Integer
Dim HeadOld As Integer
Dim HeadingsNew() As String
Dim HeadingsOld() As String
a = 1
b = 1
HeadNew = 0
HeadOld = 0
Erase HeadingsNew
Erase HeadingsOld
Worksheets("ReportNew").Activate
Do Until Len(Trim(Cells(1, a))) = 0
DoEvents
ReDim Preserve HeadingsNew(1 To a)
HeadingsNew(a) = Trim(Cells(1, a))
a = a + 1
Loop
a = a - 1
HeadNew = a
Worksheets("ReportOld").Activate
Do Until Len(Trim(Cells(1, b))) = 0
DoEvents
ReDim Preserve HeadingsOld(1 To b)
HeadingsOld(b) = Trim(Cells(1, b))
b = b + 1
Loop
b = b - 1
HeadOld = b
x = 1
Do Until x > a
DoEvents
If HeadingsNew(x) <> HeadingsOld(x) Then
MsgBox " Headings are different" & Chr(10) & Chr(10) & _
" column number " & x & Chr(10) & _
" ReportNew: " & (HeadingsNew(x)) & Chr(10) & _
" ReportOld: " & (HeadingsOld(x)), vbCritical, "Data Issue"
End If
x = x + 1
Loop
If HeadOld <> HeadNew Then
MsgBox " The number of headings don't match", vbcritacal, "Data Issue"
End If
End Sub
I suggest a variant array. Here is a simple solution.
Sub Compare()
Dim header1 As Variant, header2 As Variant, i as long
header1 = sheets("ReportOld").Rows(1).Value
header2 = sheets("ReportNew").Rows(1).Value
For i = 1 To 100000
If header1(1, i) <> vbNullString Then
If header1(1, i) <> header2(1, i) Then
MsgBox "Compare Failed at column " & i
Exit For
End If
Else
MsgBox "Compare ="
Exit For
End If
Next i
End Sub
Could someone help me find out what is wrong with this VBA Code, please?
In the vba code workbook BASE has more than 3000 items in column A and Each line has a name, for example: "B-Y0011".
I want to search this item in another workbook named in this vba code 'wb'.
BUT this workbook 'wb' has three sheets. I have to find the item in one of these sheets and the line position which the item is on.
It ran one time, but when it doesn't find it, it got an error. And now that I tried to add an ERROR function, it gives me another ERROR.
Thank you so much
Sub ATUALIZAR_ALOCACAO()
Dim caminho As String, Dim j As Variant, Dim plan As Variant, Dim plan1 As
Variant, Dim plan2 As Variant, Dim wb As Workbook, Dim ws As Worksheet
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.EnableEvents = False
mes = InputBox("Qual o mês que você está consolidando informação de Diesel?")
ano = ThisWorkbook.Sheets("BASE").Range("R1").Value
ind_mes = Application.Match(mes, ThisWorkbook.Sheets("BASE").Range("L:L"), 0)
mes_aloc = ThisWorkbook.Sheets("BASE").Range("N" & ind_mes).Value
num_mes = ThisWorkbook.Sheets("BASE").Range("M" & ind_mes).Value
If num_mes < 10 Then
num_mes_cod = "0" & num_mes
Else
num_mes_cod = num_mes
End If
caminho = "\\sedenas01\carnaxide\A&CCC\15 - Brasil - Inovação e
Desenvolvimento\PDCAs\Consumo Diesel\Alocação\2017\" & num_mes_cod &
".RELAÇÃO DE FROTAS GERAL IC " & mes_aloc & " " & ano & ".xls"
Set wb = Workbooks.Open(Filename:=caminho, ReadOnly:=True)
With wb
lastrow = ThisWorkbook.Sheets("BASE").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
j = ThisWorkbook.Sheets("BASE").Cells(i, 1).Value
plan = Application.Match(j, wb.Sheets("BETONEIRAS").Range("K:K"), 0)
On Error Resume Next
If plan > 0 Then
wb.Sheets("BETONEIRAS").Range("M" & plan).Copy
ThisWorkbook.Sheets("BASE").Range("I" & i).PasteSpecial xlPasteValues
wb.Sheets("BETONEIRAS").Range("P" & plan).Copy
ThisWorkbook.Sheets("BASE").Range("J" & i).PasteSpecial xlPasteValues
Else
plan1 = Application.Match(j, wb.Sheets("BOMBAS DE CONCRETO").Range("K:K"), 0)
If plan1 > 0 Then
wb.Sheets("BOMBAS DE CONCRETO").Range("M" & plan1).Copy
ThisWorkbook.Sheets("BASE").Range("I" & i).PasteSpecial xlPasteValues
wb.Sheets("BOMBAS DE CONCRETO").Range("P" & plan1).Copy
ThisWorkbook.Sheets("BASE").Range("J" & i).PasteSpecial xlPasteValues
Else
plan2 = Application.Match(j, wb.Sheets("BOMBAS DE CONCRETO").Range("H:H"), 0)
If plan2 > 0 Then
wb.Sheets("PÁS CARREGADEIRAS").Range("J" & plan2).Copy
ThisWorkbook.Sheets("BASE").Range("I" & i).PasteSpecial xlPasteValues
wb.Sheets("PÁS CARREGADEIRAS").Range("L" & plan2).Copy
ThisWorkbook.Sheets("BASE").Range("J" & i).PasteSpecial xlPasteValues
End If
End If
End If
Next
End With
wb.Close SaveChanges:=False
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
Been trying to find a way to populate a combobox by reading a range and only choosing the cells that have some value.
I have some code that creates a button every row at column S to open a user form with a combobox.
in column "H" from row 5 down, I have cells filled with colors (text)
My objective is that the itemlist of the combobox shows by default not the 1st item from the range (starting at H5) but the corresponding item from each cell
Here's my piece of code for populating the combobox1:
Sub testingcombo()
Dim c As Range
Dim index As Integer
ComboBox1.Clear
index = ComboBox1.ListIndex
With Worksheets("sheet1")
For Each c In .Range(.Range("H5"), .Range("H" & .Rows.Count).End(xlUp))
If c.Value <> vbNullString Then ComboBox1.AddItem c.Value
Next c
End With
Me.ComboBox1.ListIndex = 0 '(this only chooses by default the 1st entry of the range)
Thks,
Edgar
In the code associated with the buttons, write this (not my code. Look here):
Public rs As Integer
Sub MyButton()
Dim b As Object
Dim cs As Integer
Dim ss, ssv As String
Set b = ActiveSheet.Buttons(Application.Caller)
With b.TopLeftCell
rs = .Row
cs = .Column
End With
ss = Left(Cells(1, cs).Address(False, False), 1 - (ColNumber > 26)) & rs
ssv = Range(ss).Value
'MsgBox "Row Number " & rs & " Column Number " & cs & vbNewLine & _
'"Cell " & ss & " Content " & ssv
UserForm1.Show
End Sub
And then in the UserForm this:
Public Sub UserForm_Initialize()
Dim c As Range
Dim index As Integer
ComboBox1.Clear
index = ComboBox1.ListIndex
With Worksheets("sheet1")
For Each c In .Range(.Range("H5"), .Range("H" & .Rows.Count).End(xlUp))
If c.Value <> vbNullString Then ComboBox1.AddItem c.Value
Next c
End With
Me.ComboBox1.ListIndex = rs - 5
End Sub
Based on the selection made in a combo box on a userform how do I send the selection made to a desired worksheet. For example, we have 12 worksheets in a work book. Each worksheets name is a name of a month in the year. The combo box selection is all the months of the year. January - December. I f I select January in the combo box I want all the other entries on the userform to go to January worksheet. If I select February I want all the entries in the other text boxes to go to February worksheet and so on. How do I accomplish this?? Any help will be greatly appriciated!!!
I re-edited the code. Only problem now is the cellVal4 = Me.tbDate.Text The error lies with the .Text highlighted. Also when I submit the form it does not add a new row for each entry it changes the same row the first entry was on.
Option Explicit
Dim WrkSheet As Worksheet
Private Sub btnSubmit_Click()
Application.EnableEvents = False
Dim ssheet As Workbook
Dim cellVal1 As String, cellVal2 As String, cellVal3 As String, cellVal4 As String, cellVal5 As String, cellVal6 As String, cellVal7 As String, cellVal8 As String, cellVal9 As String, cellVal10 As String, cellVal11 As String, cellVal12 As String
Dim cellVal13 As String, cellVal14 As String, cellVal15 As String, cellVal16 As String, cellVal17 As String, cellVal18 As String, cellVal19 As String, cellVal20 As String, cellVal21 As String, cellVal22 As String
Dim cellVal23 As String, cellVal24 As String, cellVal25 As String, cellVal26 As String, cellVal27 As String, cellVal28 As String, cellVal29 As String, cellVal30 As String, cellVal31 As String, cellVal32 As String, cellVal33 As String, cellVal34 As String
Dim shtCmb As String
Dim RwLast As Long
shtCmb = Me.cmbListItem1.Value
If shtCmb = "" Then
MsgBox "Please choose a month.", vbOKOnly
Me.cmbListItem1.SetFocus
End If
cellVal1 = Me.cmbListItem1.Text
cellVal2 = Me.cmbListItem2.Text
cellVal3 = Me.cmbListItem3.Text
cellVal4 = Me.TextBox31.Text
cellVal5 = Me.TextBox1.Text
cellVal6 = Me.TextBox2.Text
cellVal7 = Me.TextBox3.Text
cellVal8 = Me.TextBox4.Text
cellVal9 = Me.TextBox5.Text
cellVal10 = Me.TextBox6.Text
cellVal11 = Me.TextBox7.Text
cellVal12 = Me.TextBox8.Text
cellVal13 = Me.TextBox9.Text
cellVal14 = Me.TextBox10.Text
cellVal15 = Me.TextBox11.Text
cellVal16 = Me.TextBox12.Text
cellVal17 = Me.TextBox13.Text
cellVal18 = Me.TextBox14.Text
cellVal19 = Me.TextBox15.Text
cellVal20 = Me.TextBox16.Text
cellVal21 = Me.TextBox17.Text
cellVal22 = Me.TextBox18.Text
cellVal23 = Me.TextBox19.Text
cellVal24 = Me.TextBox20.Text
cellVal25 = Me.TextBox21.Text
cellVal26 = Me.TextBox22.Text
cellVal27 = Me.TextBox23.Text
cellVal28 = Me.TextBox24.Text
cellVal29 = Me.TextBox25.Text
cellVal30 = Me.TextBox26.Text
cellVal31 = Me.TextBox27.Text
cellVal32 = Me.TextBox28.Text
cellVal33 = Me.TextBox29.Text
cellVal34 = Me.TextBox30.Text
RwLast = Worksheets(shtCmb).Range("AI" & Worksheets(shtCmb).Rows.Count).End(xlUp).Row
Worksheets(shtCmb).Range("AI" & RwLast + 1).Value = cellVal1
Worksheets(shtCmb).Range("AJ" & RwLast + 1).Value = cellVal2
Worksheets(shtCmb).Range("A" & RwLast + 1).Value = cellVal3
Worksheets(shtCmb).Range("AH" & RwLast + 1).Value = cellVal4
Worksheets(shtCmb).Range("B" & RwLast + 1).Value = cellVal5
Worksheets(shtCmb).Range("C" & RwLast + 1).Value = cellVal6
Worksheets(shtCmb).Range("D" & RwLast + 1).Value = cellVal7
Worksheets(shtCmb).Range("E" & RwLast + 1).Value = cellVal8
Worksheets(shtCmb).Range("F" & RwLast + 1).Value = cellVal9
Worksheets(shtCmb).Range("G" & RwLast + 1).Value = cellVal10
Worksheets(shtCmb).Range("H" & RwLast + 1).Value = cellVal11
Worksheets(shtCmb).Range("I" & RwLast + 1).Value = cellVal12
Worksheets(shtCmb).Range("J" & RwLast + 1).Value = cellVal13
Worksheets(shtCmb).Range("K" & RwLast + 1).Value = cellVal14
Worksheets(shtCmb).Range("L" & RwLast + 1).Value = cellVal15
Worksheets(shtCmb).Range("M" & RwLast + 1).Value = cellVal16
Worksheets(shtCmb).Range("N" & RwLast + 1).Value = cellVal17
Worksheets(shtCmb).Range("O" & RwLast + 1).Value = cellVal18
Worksheets(shtCmb).Range("P" & RwLast + 1).Value = cellVal19
Worksheets(shtCmb).Range("Q" & RwLast + 1).Value = cellVal20
Worksheets(shtCmb).Range("R" & RwLast + 1).Value = cellVal21
Worksheets(shtCmb).Range("S" & RwLast + 1).Value = cellVal22
Worksheets(shtCmb).Range("T" & RwLast + 1).Value = cellVal23
Worksheets(shtCmb).Range("U" & RwLast + 1).Value = cellVal24
Worksheets(shtCmb).Range("V" & RwLast + 1).Value = cellVal25
Worksheets(shtCmb).Range("W" & RwLast + 1).Value = cellVal26
Worksheets(shtCmb).Range("X" & RwLast + 1).Value = cellVal27
Worksheets(shtCmb).Range("Y" & RwLast + 1).Value = cellVal28
Worksheets(shtCmb).Range("Z" & RwLast + 1).Value = cellVal29
Worksheets(shtCmb).Range("AA" & RwLast + 1).Value = cellVal30
Worksheets(shtCmb).Range("AB" & RwLast + 1).Value = cellVal31
Worksheets(shtCmb).Range("AC" & RwLast + 1).Value = cellVal32
Worksheets(shtCmb).Range("AD" & RwLast + 1).Value = cellVal33
Worksheets(shtCmb).Range("AF" & RwLast + 1).Value = cellVal34
Application.EnableEvents = True
End Sub
Private Sub cmbListItem1_Change()
End Sub
Private Sub optionCancel_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim SH As Worksheet
Dim Entry As Variant
' MonthName(Month(Now)) - Will return the name of the current Month
For Each SH In ThisWorkbook.Worksheets
If SH.Name = MonthName(month(Now)) Then
Set WrkSheet = SH
Exit For
End If
Next
'fill the combo box
With Me.cmbListItem1
For Each Entry In [List1]
.AddItem Entry
Next Entry
.Value = MonthName(month(Now))
End With
'fill the combo box
With Me.cmbListItem2
For Each Entry In [List2]
.AddItem Entry
Next Entry
End With
'fill the combo box
With Me.cmbListItem3
For Each Entry In [List3]
.AddItem Entry
Next Entry
End With
End Sub
You could try something like the below within your UserForm Code:
Option Explicit
Dim WrkSheet As Worksheet
Private Sub ComboBox1_Change()
Dim SH As Worksheet
For Each SH In ThisWorkbook.Worksheets
If SH.Name = Me.ComboBox1.Value Then
Set WrkSheet = SH
Exit For
End If
Next
End Sub
Then in the rest of your UserForm code you should be able to reference the correct sheet by: Example
MsgBox WrkSheet.Range("A1").Value
EDIT: Added code
Option Explicit
Dim WrkSheet As Worksheet
Private Sub btnSubmit_Click()
Dim SSheet As Workbook
Dim NR As Long
NR = SSheet.Cells(Rows.Count, 1).Row + 1
'Not sure what you are trying to do below ???
SSheet.Cells(NR, 1) = "???"
End Sub
Private Sub cmbListItem1_Change()
Dim SH As Worksheet
For Each SH In ThisWorkbook.Worksheets
If SH.Name = Me.ComboBox1.Value Then
Set WrkSheet = SH
Exit For
End If
Next
WrkSheet.Range("AI2").Value = Me.cmbListItem1.Text
End Sub
Private Sub cmbListItem2_Change()
WrkSheet.Range("AJ2").Value = Me.cmbListItem2.Text
End Sub
Private Sub cmbListItem3_Change()
WrkSheet.Range("A2").Value = Me.cmbListItem3.Text
End Sub
Private Sub tbDate_Click()
WrkSheet.Range("AH2").Value = Me.tbDate.Text
End Sub
Private Sub TextBox1_Change()
WrkSheet.Range("B2").Value = Me.TextBox1.Text
End Sub
Private Sub TextBox2_Change()
WrkSheet.Range("C2").Value = Me.TextBox2.Text
End Sub
Private Sub TextBox3_Change()
WrkSheet.Range("D2").Value = Me.TextBox3.Text
End Sub
Private Sub UserForm_Initialize()
Dim SH As Worksheet
Dim Entry As Variant
' MonthName(Month(Now)) - Will return the name of the current Month
For Each SH In ThisWorkbook.Worksheets
If SH.Name = MonthName(Month(Now)) Then
Set WrkSheet = SH
Exit For
End If
Next
Me.tbDate = Date
'fill the combo box
With Me.cmbListItem1
For Each Entry In [List1]
.AddItem Entry
Next Entry
.Value = MonthName(Month(Now))
End With
'fill the combo box
With Me.cmbListItem2
For Each Entry In [List2]
.AddItem Entry
Next Entry
End With
'fill the combo box
With Me.cmbListItem3
For Each Entry In [List3]
.AddItem Entry
Next Entry
End With
End Sub
The above is untested, but give it a try and see if it helps resolve your issue.
EDIT: Added another code variation Below:
The Below will add all UserForm Values to the Sheet with the Month Name Selected in the List. I kept the original Columns used in your example.
Option Explicit
Dim WrkSheet As Worksheet
Private Sub btnSubmit_Click()
Dim NR As Long
Application.ScreenUpdating = False
With WrkSheet
NR = .UsedRange.Rows.Count + 1
'If there is a specific column (Example: A) you can use
'NR = .Range("A" & .UsedRange.Rows.Count).End(xlUp).Row + 1
.Range("AI" & NR).Value = Me.cmbListItem1.Text
.Range("AJ" & NR).Value = Me.cmbListItem2.Text
.Range("A" & NR).Value = Me.cmbListItem3.Text
.Range("AH" & NR).Value = Me.tbDate.Text
.Range("B" & NR).Value = Me.TextBox1.Text
.Range("C" & NR).Value = Me.TextBox2.Text
.Range("D" & NR).Value = Me.TextBox3.Text
End With
Application.ScreenUpdating = True
End Sub
Private Sub cmbListItem1_Change()
Dim SH As Worksheet
For Each SH In ThisWorkbook.Worksheets
If SH.Name = Me.ComboBox1.Value Then
Set WrkSheet = SH
Exit For
End If
Next
End Sub
Private Sub UserForm_Initialize()
Dim SH As Worksheet
Dim Entry As Variant
Set WrkSheet = Sheet3 ' You can Change or Remove This if you choose
' MonthName(Month(Now)) - Will return the name of the current Month
For Each SH In ThisWorkbook.Worksheets
If SH.Name = MonthName(Month(Now)) Then
Set WrkSheet = SH
Exit For
End If
Next
Me.tbDate = Date
'fill the combo box
With Me.cmbListItem1
For Each Entry In [List1]
.AddItem Entry
Next Entry
.Value = MonthName(Month(Now))
End With
'fill the combo box
With Me.cmbListItem2
For Each Entry In [List2]
.AddItem Entry
Next Entry
End With
'fill the combo box
With Me.cmbListItem3
For Each Entry In [List3]
.AddItem Entry
Next Entry
End With
End Sub
If your first combobox will only have the names of your sheets, you could use this instead to shorten your code significantly:
Private Sub cmbListItem1_Change()
Dim cellVal as String
Dim shtCmb As String
shtCmb = Me.cmbListItem1.Value
cellVal = Me.cmbListItem1.Text
If shtCmb = "" Then
MsgBox "Please choose a month.", vbOKOnly
Me.cmbListItem1.SetFocus
End If
Worksheets(shtCmb).Range("AI2").Value = cellVal
End Sub
For each of your combobox inputs, you can just change the output variable for the cell's value.
Private Sub cmbListItem2_Change()
Dim cellVal as String
Dim shtCmb As String
shtCmb = Me.cmbListItem1.Value
cellVal = Me.cmbListItem2.Text
If shtCmb = "" Then
MsgBox "Please choose a month.", vbOKOnly
Me.cmbListItem1.SetFocus
End If
Worksheets(shtCmb).Range("AJ2").Value = cellVal
End Sub
However, this code should change the values of the cells in those sheets every time a change is made. If that's what you want, this should do it. If you want it to input all of the values when you click an enter button, I can help with that too.
EDIT:
I've changed the code to update the cells on your accept button click event (what I'm assuming to be an accept button anyways) and update the next empty cells below whatever is already in there. This code assumes that some values are already in row 1, most likely headers. Give this a shot on a copy of your workbook, not the actual one, and it should work. I am unable to test this as I don't have a copy of your working data.
Private Sub btnSubmit_Click()
Dim ssheet As Workbook
Dim cellVal1 As String, cellVal2 As String, cellVal3 As String, cellVal4 As String, cellVal5 As String
Dim cellVal6 As String, cellVal7 As String
Dim shtCmb As String
Dim RwLast As Long
shtCmb = Me.cmbListItem1.Value
If shtCmb = "" Then
MsgBox "Please choose a month.", vbOKOnly
Me.cmbListItem1.SetFocus
End If
cellVal1 = Me.cmbListItem1.Text
cellVal2 = Me.cmbListItem2.Text
cellVal3 = Me.cmbListItem3.Text
cellVal4 = Me.tbDate.Text
cellVal5 = Me.TextBox1.Text
cellVal6 = Me.TextBox2.Text
cellVal7 = Me.TextBox3.Text
RwLast = Range("AI" & ActiveSheet.Rows.Count).End(xlUp).Row
Worksheets(shtCmb).Range("AI" & RwLast + 1).Value = cellVal1
Worksheets(shtCmb).Range("AJ" & RwLast + 1).Value = cellVal2
Worksheets(shtCmb).Range("A" & RwLast + 1).Value = cellVal3
Worksheets(shtCmb).Range("AH" & RwLast + 1).Value = cellVal4
Worksheets(shtCmb).Range("B" & RwLast + 1).Value = cellVal5
Worksheets(shtCmb).Range("C" & RwLast + 1).Value = cellVal6
Worksheets(shtCmb).Range("D" & RwLast + 1).Value = cellVal7
End Sub
Private Sub UserForm_Initialize()
Me.tbDate = Date
'fill the combo box
For Each entry In [List1]
Me.cmbListItem1.AddItem entry
Next entry
'fill the combo box
For Each entry In [List2]
Me.cmbListItem2.AddItem entry
Next entry
'fill the combo box
For Each entry In [List3]
Me.cmbListItem3.AddItem entry
Next entry
End Sub
Note that this is a very clumsy way of completing this code on my part, I know there should be a better way to iterate between your ranges and entry values, but as I am not a master this is the simplest way to complete the code.