VBA code to create command button and copy criteria based data from one worksheet to another

[MMessenger98]

Hi All,

I could be approaching this in the complete wrong way so apologies if that is the case.

I have a basic form that I want to use to track quality assurance. The process is included in Col C, the score in Col D and then I have a Data validation list in in cell H4 (Date) and Cell H5 (Agent). Ideally I want to be able to select the date in mmm:yy format and the agent name, fill out the form and then use a command button to submit those results to another worksheet within the same workbook and paste them in the relevant cell based on the criteria provided.

As an example in relation to the images provided If I have chosen Jan-24 from date list and Matt Smith as agent and then keyed 10% in D4, 10% in D5 and then submit I'd like the data to be pasted on Data sheet in cells C2 and C3.

Looking for a VBA code that would achieve this.

EDIT:
Thank you in advance for any help with the VBA code or alternative solutions for how I should be setting up the worksheets to achieve this.

 

[Tupe77]

Do you mean something like this?
Can't see the row and column addresses in the pictures you posted, so you have to change them to the correct ones.

Sub TS_DataTrans()
Dim wsForm As Worksheet: Set wsForm = Worksheets(1) ' WorkSheet with Form ***** Change if necessary
Dim wsData As Worksheet: Set wsData = Worksheets(2) ' Worksheet with Data ***** Change if necessary
Dim DateRNG As Range, AgentRNG As Range, FormDataRNG As Range
Set DateRNG = wsForm.Range("H10")   ' Date to search ***** Change if necessary
Set AgentRNG = wsForm.Range("H11")  ' Agent to search ***** Change if necessary
Set FormDataRNG = wsForm.Range("d10:d13") ' Cells to copy from Form ***** Change if necessary

Dim TmpRNG As Range

Set TmpRNG = wsData.Rows(1).Cells.Find(CDate(CStr(DateRNG.Value)), LookAt:=xlWhole, LookIn:=xlFormulas) ' Find Column (Date)
If TmpRNG Is Nothing Then
    MsgBox "Date was not found.": Exit Sub
Else
    Dim CurrentDateCol As Integer: CurrentDateCol = TmpRNG.Column ' Get Column No.
End If

Set TmpRNG = wsData.Columns(1).Cells.Find(AgentRNG.Value, LookIn:=xlValues) ' Find Row (Agent)
If TmpRNG Is Nothing Then
    MsgBox "Date was not found.": Exit Sub
Else
    Dim CurrentAgentRow As Long: CurrentAgentRow = TmpRNG.Row ' Get Row No.
End If

wsData.Cells(CurrentAgentRow, CurrentDateCol).Resize(4, 1).Value = FormDataRNG.Value ' Copy Data from Form Sheet to Data Sheet

End Sub

My apologies for any quirks, English is not my native language. "So I blame Google translate for all my goofs."

 

[MMessenger98]

Hi, yes I assume the above will work but maybe I'm just missing some bits. At the moment I click the control box to submit but nothing happens. Adjusted code below

Sub TS_DataTrans()
Dim wsForm As Worksheet: Set wsForm = Worksheets("QC Form") ' WorkSheet with QC Form ***** Change if necessary
Dim wsData As Worksheet: Set wsData = Worksheets("Agent Level Data") ' Worksheet with Agent Level Data ***** Change if necessary
Dim DateRNG As Range, AgentRNG As Range, FormDataRNG As Range
Set DateRNG = wsForm.Range("H4") ' Date to search ***** Change if necessary
Set AgentRNG = wsForm.Range("H5") ' Agent to search ***** Change if necessary
Set FormDataRNG = wsForm.Range("d4:d38") ' Cells to copy from QC Form ***** Change if necessary
Dim TmpRNG As Range
Set TmpRNG = wsData.Rows(1).Cells.Find(CDate(CStr(DateRNG.Value)), LookAt:=xlWhole, LookIn:=xlFormulas) ' Find Column (Date)
If TmpRNG Is Nothing Then
MsgBox "Date was not found.": Exit Sub
Else
Dim CurrentDateCol As Integer: CurrentDateCol = TmpRNG.Column ' Get Column No.
End If
Set TmpRNG = wsData.Columns(1).Cells.Find(AgentRNG.Value, LookIn:=xlValues) ' Find Row (Agent)
If TmpRNG Is Nothing Then
MsgBox "Date was not found.": Exit Sub
Else
Dim CurrentAgentRow As Long: CurrentAgentRow = TmpRNG.Row ' Get Row No.
End If
wsData.Cells(CurrentAgentRow, CurrentDateCol).Resize(4, 1).Value = FormDataRNG.Value ' Copy Data from Form Sheet to Data Sheet
End Sub

Is there more lines I need to amend maybe?

Thank you

 

[Tupe77]

Have you attached the TS_DataTrans macro to that button?

Right click button -> select Assign macro -> select TS_DataTrans from the list

 

[MMessenger98]

Not sure if the additional images below would help based on the real scenario rather then the example one I used previously. My data sheet goes from A1 to Z1541. You should be able to see the row and Col for the QC form.

I've added the control box visual code.

When I click right on the 'submit' button which is the control box it doesn't do anything. I tried to click on design mode and then right click on the submit button but the option to assign macro doesn't come up. If I try to run the code manually though it does ask me what to run it against and I've chosen TS_DataTrans from the list but it still doesn't seem to run.

 

[Tupe77]

I've added the control box visual code

Change:
Call submit
to:
Call TS_DataTrans

 

[Tupe77]

Fixed ranges.
Does this work in principle?

Sub TS_DataTrans()
Dim wsForm As Worksheet: Set wsForm = Worksheets("QC Form") ' WorkSheet with Form ***** Change if necessary
Dim wsData As Worksheet: Set wsData = Worksheets("Agent Level Data") ' Worksheet with Data ***** Change if necessary
Dim DateRNG As Range, AgentRNG As Range, FormDataRNG As Range
Set DateRNG = wsForm.Range("H4")   ' Date to search ***** Change if necessary
Set AgentRNG = wsForm.Range("H5")  ' Agent to search ***** Change if necessary
Set FormDataRNG = wsForm.Range("d4:d38") ' Cells to copy from Form ***** Change if necessary

Dim TmpRNG As Range

Set TmpRNG = wsData.Rows(1).Cells.Find(CDate(CStr(DateRNG.Value)), LookAt:=xlWhole, LookIn:=xlFormulas) ' Find Column (Date)
If TmpRNG Is Nothing Then
    MsgBox "Date was not found.": Exit Sub
Else
    Dim CurrentDateCol As Integer: CurrentDateCol = TmpRNG.Column ' Get Column No.
End If

Set TmpRNG = wsData.Columns(1).Cells.Find(AgentRNG.Value, LookIn:=xlValues) ' Find Row (Agent)
If TmpRNG Is Nothing Then
    MsgBox "Date was not found.": Exit Sub
Else
    Dim CurrentAgentRow As Long: CurrentAgentRow = TmpRNG.Row ' Get Row No.
End If

wsData.Cells(CurrentAgentRow, CurrentDateCol).Resize(35, 1).Value = FormDataRNG.Value                                                                ' Copy Data from Form Sheet to Data Sheet

End Sub

My apologies for any quirks, English is not my native language. "So I blame Google translate for all my goofs."

 

[MMessenger98]

Seem to just get an error box pop up that says 'date not found'?

 

[Tupe77]

The code uses Excel's built-in (range.find) function, but it really doesn't like dates.

Check that:
Worksheets("QC Form").range("H4")
and
Worksheets("Agent Level Data")
use exactly the same formatting.

(What formatting is defined for them?)

 

[MMessenger98]

I did wonder this whilst I was sending the previous message.

The QC Form data is from a data validation list and the format is (MMM:YY) so Jan-24 but the actual date keyed is 01/01/24 whereas on agent level data it appears the format is simply Jan-24 and has been keyed that way rather then 01/01/24. Both however are the same format.