Add worksheets in combobox to enter and save record to selected sheetname automatically

nagavasarala

New Member
Joined
Jan 6, 2018
Messages
15
Hi,

I need to maintain my daily sales month wise so have created recommended user form but i have total 12 worksheets in one workbook

so i need to create a combobox in userform and need to Add worksheets in combobox to enter and save record to selected sheetname automatically.

can you help me to figure out the coding.


have given the below but the same is not working.

Private Sub UserForm_Initialize()
For Each sht In ActiveWorkbook.Sheets
Me.ComboBox1.AddItem sht.Name
Next sht


End Sub

please help me
 
Okay, below is code

Private Sub CommandButton1_Click()
Dim currentrow
currentrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(currentrow, 1) = TextBox1
If Application.WorksheetFunction.CountIf(Range("A2:A" & currentrow), Cells(currentrow, 1)) > 1 Then
MsgBox "Duplicate data!", vbCritical, "Remove Data"
Cells(currentrow, 1) = ""
ElseIf Application.WorksheetFunction.CountIf(Range("A2:A" & currentrow), Cells(currentrow, 1)) = 1 Then
answer = MsgBox("Save the data?", vbYesNo + vbQuestion, "Add Record")
If answer = vbYes Then


Cells(currentrow, 1) = TextBox1.Text
Cells(currentrow, 2) = TextBox2.Text
Cells(currentrow, 3) = TextBox3.Text
Cells(currentrow, 4) = ComboBox1.List
Cells(currentrow, 5) = ComboBox2.List
Cells(currentrow, 6) = ComboBox3.List
Cells(currentrow, 7) = TextBox4.Text
Cells(currentrow, 8) = TextBox5.Text
Cells(currentrow, 9) = TextBox6.Text
Cells(currentrow, 10) = TextBox7.Text
Cells(currentrow, 11) = TextBox8.Text
Cells(currentrow, 12) = TextBox9.Text
If UserForm1.OptionButton1.Value Then
Cells(currentrow, 13) = "BTA"
Else
If UserForm1.OptionButton2.Value Then
Cells(currentrow, 13) = "NON-BTA"
End If
End If
Cells(currentrow, 14) = TextBox10.Text
Cells(currentrow, 15) = TextBox11.Value
Cells(currentrow, 16) = TextBox12.Value
Cells(currentrow, 17) = TextBox13.Value
Cells(currentrow, 18) = TextBox14.Value
Cells(currentrow, 19) = TextBox15.Value
Cells(currentrow, 20) = TextBox16.Value
Cells(currentrow, 21) = TextBox17.Value
Cells(currentrow, 22) = TextBox18.Value
Cells(currentrow, 23) = TextBox19.Value
Cells(currentrow, 24) = TextBox20.Value
Cells(currentrow, 25) = TextBox21.Value
Cells(currentrow, 26) = TextBox22.Value
End If
End If
End Sub
 
Upvote 0

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Ok, try this
Code:
Private Sub CommandButton1_Click()
   Dim currentrow
   
   With Sheets(ComboBox1.Value)
      currentrow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
      Cells(currentrow, 1) = TextBox1.Text
      If Application.WorksheetFunction.CountIf(.Range("A2:A" & currentrow), .Cells(currentrow, 1)) > 1 Then
         MsgBox "Duplicate data!", vbCritical, "Remove Data"
         .Cells(currentrow, 1) = ""
      ElseIf Application.WorksheetFunction.CountIf(.Range("A2:A" & currentrow), .Cells(currentrow, 1)) = 1 Then
         answer = MsgBox("Save the data?", vbYesNo + vbQuestion, "Add Record")
         If answer = vbYes Then
            .Cells(currentrow, 1) = TextBox1.Text
            .Cells(currentrow, 2) = textbox2.Text
            .Cells(currentrow, 3) = textbox3.Text
            .Cells(currentrow, 4) = ComboBox1.list
            .Cells(currentrow, 5) = ComboBox2.list
            .Cells(currentrow, 6) = ComboBox3.list
            .Cells(currentrow, 7) = TextBox4.Text
            .Cells(currentrow, 8) = TextBox5.Text
            .Cells(currentrow, 9) = TextBox6.Text
            .Cells(currentrow, 10) = TextBox7.Text
            .Cells(currentrow, 11) = TextBox8.Text
            .Cells(currentrow, 12) = TextBox9.Text
            If UserForm1.OptionButton1.Value Then
               .Cells(currentrow, 13) = "BTA"
            Else
               If UserForm1.OptionButton2.Value Then
                  .Cells(currentrow, 13) = "NON-BTA"
               End If
            End If
            .Cells(currentrow, 14) = TextBox10.Text
            .Cells(currentrow, 15) = TextBox11.Value
            .Cells(currentrow, 16) = TextBox12.Value
            .Cells(currentrow, 17) = TextBox13.Value
            .Cells(currentrow, 18) = TextBox14.Value
            .Cells(currentrow, 19) = TextBox15.Value
            .Cells(currentrow, 20) = TextBox16.Value
            .Cells(currentrow, 21) = TextBox17.Value
            .Cells(currentrow, 22) = TextBox18.Value
            .Cells(currentrow, 23) = TextBox19.Value
            .Cells(currentrow, 24) = TextBox20.Value
            .Cells(currentrow, 25) = TextBox21.Value
            .Cells(currentrow, 26) = TextBox22.Value
         End If
      End If
   End With
End Sub
 
Upvote 0
Ok this should come up with a message box, does it? & if so what did the messagebox say?
 
Upvote 0
basically i need a combobox with loaded all sheets in my current workbook, when user form initialize combobox should loaded with the sheetsnames and if i select particular sheetname and enter the data through User form it should save in the selected sheet.
 
Upvote 0
What did the message box say?
 
Upvote 0
In order to help you further, I need to know what the message box said.
Therefore can you please answer my question?
 
Upvote 0
Sorry Bro,

Actually, When I run program User form is working properlly and all fields are perfectly fiits and able to select the worksheet name in combobox and enter the date in all fields but when i click the save button it is not responding means no msg box and nothing adding in the selected work sheet user form completely nutral status.

Only exit button is working when i click exit button user form is unloading.



below is complete coding


Dim currentrow As Long


Private Sub CommandButton1_Click()
Dim currentrow

With Sheets(ComboBox1.Value)
currentrow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(currentrow, 1) = TextBox1.Text
'currentrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
'Cells(currentrow, 1) = TextBox1
If Application.WorksheetFunction.CountIf(Range("A2:A" & currentrow), .Cells(currentrow, 1)) > 1 Then
MsgBox "Duplicate data!", vbCritical, "Remove Data"
.Cells(currentrow, 1) = ""
ElseIf Application.WorksheetFunction.CountIf(Range("A2:A" & currentrow), .Cells(currentrow, 1)) = 1 Then
answer = MsgBox("Save the data?", vbYesNo + vbQuestion, "Add Record")
If answer = vbYes Then
.Cells(currentrow, 1) = TextBox1.Text
.Cells(currentrow, 2) = TextBox2.Text
.Cells(currentrow, 3) = TextBox3.Text
.Cells(currentrow, 4) = ComboBox2.List
.Cells(currentrow, 5) = ComboBox3.List
.Cells(currentrow, 6) = ComboBox4.List
.Cells(currentrow, 7) = TextBox4.Text
.Cells(currentrow, 8) = TextBox5.Text
.Cells(currentrow, 9) = TextBox6.Text
.Cells(currentrow, 10) = TextBox7.Text
.Cells(currentrow, 11) = TextBox8.Text
.Cells(currentrow, 12) = TextBox9.Text
If UserForm1.OptionButton1.Value Then
.Cells(currentrow, 13) = "BTA"
Else
If UserForm1.OptionButton2.Value Then
.Cells(currentrow, 13) = "NON-BTA"
End If
End If
.Cells(currentrow, 14) = TextBox10.Text
.Cells(currentrow, 15) = TextBox11.Value
.Cells(currentrow, 16) = TextBox12.Value
.Cells(currentrow, 17) = TextBox13.Value
.Cells(currentrow, 18) = TextBox14.Value
.Cells(currentrow, 19) = TextBox15.Value
.Cells(currentrow, 20) = TextBox16.Value
.Cells(currentrow, 21) = TextBox17.Value
.Cells(currentrow, 22) = TextBox18.Value
.Cells(currentrow, 23) = TextBox19.Value
.Cells(currentrow, 24) = TextBox20.Value
.Cells(currentrow, 25) = TextBox21.Value
.Cells(currentrow, 26) = TextBox22.Value
End If
End If
End With


End Sub


Private Sub UserForm_Initialize()
Me.TextBox1 = Application.WorksheetFunction.Max(Range("A:A")) + 1
Me.TextBox2 = Date
Me.TextBox7 = Date
Me.TextBox8 = Date
Me.TextBox10 = Date
For Each sht In ActiveWorkbook.Sheets
Me.ComboBox1.AddItem sht.Name
Next sht


End Sub
'Private Sub ComboBox1_Change()
'Dim sht As Worksheet
'ComboBox1.Clear
'For Each sht In ActiveWorkbook.Worksheets
' ComboBox1.AddItem sht.Name
'Next sht
'ComboBox1.ListIndex = 0
'End Sub




Private Sub CommandButton2_Click()
Unload Me


End Sub
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,331
Members
452,636
Latest member
laura12345

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