VBA - Data Entry Sheet

Smilechild793

New Member
Joined
Apr 27, 2017
Messages
20
I have a workbook with 4 sheets.

The "Input Sheet" has data made to resemble a Userform (Cells B4,B6,&B8 have descriptions and cells C4,C6,&C8 have bank cells for data input). Sheet1, Sheet2, & Sheet3 are all the same with A1,B1,&C1 containing the headers laid out in the Input Sheet.

Basically, I am attempting to make a Userform-like sheet where my employees can input the necessary data into cells C4,C6,&C8. Then select a button below those cells that will transfer it to whatever sheet they choose in the whichsheet inputbox that appears.

I have everything working except for the transfer part. I do not know how to reference the cells I want to move (C4,C6,C8) and connect that to the decision made for the whichsheet portion.

Ex: if someone inputs their data then pushes the button. Then selects that they want it moved to Sheet2. How do I get that specific data to move to the correct sheet they choose?

Please see code below (I bolded where I think the problem is occurring):


Code:
[FONT=Arial]Private Sub CommandButton2_Click()[/FONT][FONT=Arial]whichsheet = InputBox("In which sheet do you wish to enter data?", "Sheet Number")[/FONT]
[FONT=Arial]If whichsheet = "" Then[/FONT]
[FONT=Arial]MsgBox "You didn't specify a sheet!"[/FONT]
[FONT=Arial]Exit Sub[/FONT]
[FONT=Arial]End If[/FONT]
[FONT=Arial]
[/FONT]
[FONT=Arial]Worksheets(whichsheet).<wbr>Activate[/FONT]
[FONT=Arial]Dim lastrow[/FONT]
[FONT=Arial]lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row[/FONT]
[FONT=Arial]
[/FONT]
[FONT=Arial]lastrow = lastrow + 1[/FONT]
[FONT=Arial]Cells(lastrow, 1) = Application.Workbooks("TEST").<wbr>Worksheets("Input").Cells(4, "C")[/FONT]
[FONT=Arial]
[/FONT]
[FONT=Arial]If Application.WorksheetFunction.<wbr>CountIf(Range("A2:A" & lastrow), Cells(lastrow, 1)) > 1 Then[/FONT]
[FONT=Arial]MsgBox "Duplicate data! Only unique IDs allowed", vbCritical, "Remove Data"[/FONT]
[FONT=Arial]Cells(lastrow, 1) = ""[/FONT]
[FONT=Arial]ElseIf Application.WorksheetFunction.<wbr>CountIf(Range("A2:A" & lastrow), Cells(lastrow, 1)) = 1 Then[/FONT]
[FONT=Arial]answer = MsgBox("Are you sure you wan to add the record?", vbYesNo + vbQuestion, "Add Record")[/FONT]
[FONT=Arial]If answer = vbYes Then[/FONT]
[FONT=Arial][B]Cells(lastrow, 1) = .Cells(4, 3)[/B][/FONT]
[FONT=Arial][B]Cells(lastrow, 2) = .Cells(6, 3)[/B][/FONT]
[FONT=Arial][B]Cells(lastrow, 3) = .Cells(8, 3)[/B][/FONT]
[FONT=Arial]
[/FONT]
[FONT=Arial]End If[/FONT]
[FONT=Arial]End If[/FONT]
[FONT=Arial]End Sub[/FONT]
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Well I took out the part about looking for duplicates because I could not determine what duplicates you were looking for.

Here is the way I would write the script.
And I put in a error checking code to insure a proper sheet name was entered.

Code:
Private Sub CommandButton2_Click()
'Modified  1/20/2019  12:03:23 AM  EST
On Error GoTo M
Dim lastrow As Long
Dim whichsheet As String
whichsheet = InputBox("In which sheet do you wish to enter data?", "Sheet Number")
    If whichsheet = "" Then
        MsgBox "You didn't specify a sheet!"
        Exit Sub
    End If
lastrow = Sheets(whichsheet).Cells(Rows.Count, 1).End(xlUp).Row + 1
With Sheets(whichsheet)
.Cells(lastrow, 1).Value = Sheets("Input Sheet").Cells(4, 3).Value
.Cells(lastrow, 2).Value = Sheets("Input Sheet").Cells(6, 3).Value
.Cells(lastrow, 3).Value = Sheets("Input Sheet").Cells(8, 3).Value
End With
Exit Sub
M:
MsgBox "You entered sheet name  " & whichsheet & "  Which Does not exist. So I stopped script"
End Sub
 
Upvote 0
Well I took out the part about looking for duplicates because I could not determine what duplicates you were looking for.

Here is the way I would write the script.
And I put in a error checking code to insure a proper sheet name was entered.

Code:
Private Sub CommandButton2_Click()
'Modified  1/20/2019  12:03:23 AM  EST
On Error GoTo M
Dim lastrow As Long
Dim whichsheet As String
whichsheet = InputBox("In which sheet do you wish to enter data?", "Sheet Number")
    If whichsheet = "" Then
        MsgBox "You didn't specify a sheet!"
        Exit Sub
    End If
lastrow = Sheets(whichsheet).Cells(Rows.Count, 1).End(xlUp).Row + 1
With Sheets(whichsheet)
.Cells(lastrow, 1).Value = Sheets("Input Sheet").Cells(4, 3).Value
.Cells(lastrow, 2).Value = Sheets("Input Sheet").Cells(6, 3).Value
.Cells(lastrow, 3).Value = Sheets("Input Sheet").Cells(8, 3).Value
End With
Exit Sub
M:
MsgBox "You entered sheet name  " & whichsheet & "  Which Does not exist. So I stopped script"
End Sub

This is perfect, thank you!!
What would I do if lets say cell (4,3) was a checkbox and I wanted it to transfer over the check mark or if not checked, the blank?
 
Upvote 0
So it works perfect but now you want changes?
You said
What would I do if lets say cell (4,3) was a checkbox and I wanted it to transfer over the check mark or if not checked, the blank?

I do not know how you can say cells(4,3) is a check box

A cell is a cell and a checkbox is a checkbox

Like a Apple cannot be a pear
 
Upvote 0
I just do not know how a checkbox can be used with this script.
A checkbox value is either True or False
You said:
transfer over the check mark

There is no check mark.

It's either true or false

 
Upvote 0
So it works perfect but now you want changes?
You said
What would I do if lets say cell (4,3) was a checkbox and I wanted it to transfer over the check mark or if not checked, the blank?

I do not know how you can say cells(4,3) is a check box

A cell is a cell and a checkbox is a checkbox

Like a Apple cannot be a pear

Exactly, I need to add a checkbox in the cell. And oh, hmm..
 
Upvote 0
A Activex check box can be set over a cell but not in a cell.

So you can just do that yourself why do you need a script to do this?
And what will this checkbox be used for?
 
Upvote 0
I just do not know how a checkbox can be used with this script.
A checkbox value is either True or False
You said:
transfer over the check mark

There is no check mark.

It's either true or false


This makes sense. Essentially, I need to add something like the below:

Code:
If Optionbutton1.Value = True Then
Worksheets("X").Cells(4,3).Value = "X"

??
 
Upvote 0
So try this:
Code:
Private Sub CommandButton1_Click()
If OptionButton1.Value = True Then Sheets("Jane").Cells(4, 3).Value = "Mom"
End Sub
 
Upvote 0
So try this:
Code:
Private Sub CommandButton1_Click()
If OptionButton1.Value = True Then Sheets("Jane").Cells(4, 3).Value = "Mom"
End Sub

I figured it out! Doesn't transfer a check, but an "X" will do. I ended up with the below:
Code:
lastrow = Sheets(whichsheet).Cells(Rows.Count, 1).End(xlUp).Row + 1With Sheets(whichsheet)
.Cells(lastrow, 1).Value = Sheets("Data Entry").Cells(2, 2).Value
If Cells(4, 3) = True Then
Worksheets("Print").Cells(2, 2).Value = "X"
End If
 
Upvote 0

Forum statistics

Threads
1,214,976
Messages
6,122,541
Members
449,089
Latest member
davidcom

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