Find and display results from userform selected criteria to Excel worksheet

Mr.Daines

Board Regular
Joined
May 31, 2011
Messages
106
Hello,

Sorry first off if the title of my question is a little confusing.

Firstly if i explain what i have created so far it may be easier to understand.

I have created a workbook from which a userform is enabled, this userform allows people to submit information to a secondary workbook on a shared network drive.

There is a subform that allows people to find out the number of referrals they have made and how many have opened, based on Team Name, Person and date from / to.

This works great, but, what i want to be able to do is display the relative results in the worksheet.

My report userform currently populates cells in excel with the parameters selected, which in turn is relative to a formula contained in the cells (sumproduct) which then displays a number of referrals and opened accounts (from the master data sheet [excel] on the shared network drive *i dont have access.)

I am using Excel 2007.

Is this possible?

Sorry if anyone still doesn't fully understand my question.

I'm sorry but i am unsure how best to post examples of my work so far.

I am unsure how to attach the workbook and i am not using code at this time to get the results, just excel formula sumproduct.
 
Last edited:

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Here is the code i am using to make the data submission
Code:
Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Dim wb As Workbook
'checks for data entry in each field
If Not IsDate(Me.TextBoxDate.Value) Then
  MsgBox "Please enter Date in DD/MM/YY format."
  Me.TextBoxDate.SetFocus
  Me.TextBoxDate.Value = ""
  Exit Sub
End If
If Me.ComboBoxAdv.Value = "" Then
  Me.ComboBoxAdv.SetFocus
  MsgBox "Please select an advisor."
  Exit Sub
End If
If Me.ComboBoxTeam.Value = "" Then
  Me.ComboBoxTeam.SetFocus
  MsgBox "Please select Team."
  Exit Sub
End If
If Not IsNumeric(Me.TextBoxRef.Value) Then
  MsgBox "Please enter reference number in a numeric format eg. 1234567."
  Me.TextBoxRef.SetFocus
  Me.TextBoxRef.Value = ""
  Exit Sub
End If
If Me.TextBoxCust.Value = "" Then
  Me.TextBoxCust.SetFocus
  MsgBox "Please enter Customers Name."
  Exit Sub
End If
If Me.TextBoxPC.Value = "" Then
  Me.TextBoxPC.SetFocus
  MsgBox "Please enter customers Postcode."
  Exit Sub
End If
If Me.ComboBoxRef.Value = "" Then
  Me.ComboBoxRef.SetFocus
  MsgBox "Please select who you have referred the lead to."
  Exit Sub
  
End If
'checks date correct for referrals from previous days
If Not CStr(Me.TextBoxDate.Value) = CVar(Date) Then
    
    MSG2 = MsgBox("Are you sure you want to make a referral from " & Me.TextBoxDate.Value _
     & " and not from todays date? " & Date, vbYesNo, "Historical STB referral detected!")
    
    End If
    
If MSG2 = vbNo Then
    Me.TextBoxDate.Value = ""
    Me.TextBoxDate.SetFocus
    Exit Sub
    
End If
'Checks if master in use
Set wb = Workbooks.Open("S:\STB Data.xlsx")
While wb.ReadOnly
    wb.Close
    Set wb = Nothing
    Set wb = Workbooks.Open("S:\STB Data.xlsx")
    DoEvents
Wend
Set ws = wb.Worksheets("STB Data")
'finds first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(1, 1).Row
  
'places data into master call log
ws.Cells(iRow, 1).Value = ThisWorkbook.Sheets("confidential").Range("I1").Value
ws.Cells(iRow, 2).Value = Me.TextBoxDate.Value
ws.Cells(iRow, 3).Value = Me.ComboBoxAdv.Value
ws.Cells(iRow, 4).Value = Me.ComboBoxTeam.Value
ws.Cells(iRow, 5).Value = Me.TextBoxRef.Value
ws.Cells(iRow, 6).Value = Me.TextBoxCust.Value
ws.Cells(iRow, 7).Value = Me.TextBoxPC.Value
ws.Cells(iRow, 8).Value = Me.ComboBoxRef.Value
ws.Cells(iRow, 9).Value = ""
ws.Cells(iRow, 10).Value = "1"
ActiveWorkbook.Close SaveChanges:=True
'confirms if user wants to make a second referral
MSG1 = MsgBox("Submission successful, do you wish to refer another?", vbYesNo, "Congratulations!")
If MSG1 = vbNo Then
    Unload Me
    Load cmdUser
    cmdUser.Show
Else
    Me.TextBoxDate.Value = ""
    Me.ComboBoxAdv.Value = ""
    Me.ComboBoxTeam.Value = ""
    Me.TextBoxRef.Value = ""
    Me.TextBoxCust.Value = ""
    Me.TextBoxPC.Value = ""
    Me.ComboBoxRef.Value = ""
    Me.TextBoxDate.SetFocus
End If
End Sub
Private Sub cmdReset_Click()
MSG4 = MsgBox("Do you want to clear all fields?", vbYesNo, "Congratulations!")
If MSG4 = vbYes Then
'clears all data from user form
Me.TextBoxDate.Value = ""
Me.ComboBoxAdv.Value = ""
Me.ComboBoxTeam.Value = ""
Me.TextBoxRef.Value = ""
Me.TextBoxCust.Value = ""
Me.TextBoxPC.Value = ""
Me.ComboBoxRef.Value = ""
Me.TextBoxDate.SetFocus
Exit Sub
End If
End Sub

Private Sub ComboBoxTeam_Change()
    Select Case ComboBoxTeam
    
    Case "Martin"
    
    ComboBoxAdv.RowSource = "confidential!Team_Martin"
    
    Case "O'Shea"
    
    ComboBoxAdv.RowSource = "confidential!Team_OShea"
    
    Case "Taylor"
    
    ComboBoxAdv.RowSource = "confidential!Team_taylor"
    
    Case "Keighley"
    
    ComboBoxAdv.RowSource = "confidential!Team_Keighley"
    
    Case "Winback"
    
    ComboBoxAdv.RowSource = "confidential!Team_Winback"
    
    Case Else
    
    Me.ComboBoxAdv.Value = ""
    
    End Select
    
End Sub

And here is the code from my report user form
Code:
Private Sub cmdReset_Click()
Sheets("reportdata").Range("B7").Value = ""
Sheets("reportdata").Range("B8").Value = ""
ComboBoxTeam.Value = ""
ComboBoxTeam.BackColor = RGB(255, 255, 255)
ComboBoxAdv.Value = ""
ComboBoxAdv.BackColor = RGB(255, 255, 255)
Me.ComboBoxTeam.SetFocus
End Sub
Private Sub cmdRun_Click()
Sheets("reportdata").Range("B8").Value = ""
Application.ScreenUpdating = False
Application.StatusBar = "Please Wait The Report Is Building"
If Trim(ComboBoxTeam.Value) = "" Then
Me.ComboBoxTeam.SetFocus
Me.ComboBoxTeam.BackColor = RGB(255, 0, 0)
MsgBox "Please enter team to continue", , "Error"
Exit Sub
End If
If Trim(ComboBoxAdv.Value) = "" Then
Me.ComboBoxAdv.SetFocus
Me.ComboBoxAdv.BackColor = RGB(255, 0, 0)
MsgBox "Please enter advisor to continue", , "Error"
Exit Sub
End If
If Me.Calendar1.Value = "" Then
Me.Calendar1.SetFocus
MsgBox "Please enter date from using the calendar control", , "Error"
Exit Sub
End If
If Me.Calendar2.Value = "" Then
Me.Calendar2.SetFocus
MsgBox "Please enter date to using the calendar control", , "Error"
Exit Sub
End If
Sheets("reportdata").Range("A3").Value = Me.ComboBoxTeam.Value
Sheets("ReportData").Range("B3").Value = Me.ComboBoxAdv.Value
Sheets("ReportData").Range("C3").Value = Me.Calendar1.Value
Sheets("ReportData").Range("D3").Value = Me.Calendar2.Value
Sheets("reportdata").Range("B6").Value = "This report is for Team " & Me.ComboBoxTeam.Value
Sheets("reportdata").Range("B7").Value = "Report ran at " & Now
With Worksheets("reportdata")
    .Visible = xlSheetVisible
    .Activate
    .Range("A1").Select
    End With
Worksheets("dashboard").Visible = xlSheetVeryHidden
Application.StatusBar = False
Application.ScreenUpdating = True
Unload Me
End Sub

Private Sub ComboBoxTeam_Change()
    Select Case ComboBoxTeam
    
    Case "Martin"
    
    ComboBoxAdv.RowSource = "confidential!Report_Martin"
    
    Case "O'Shea"
    
    ComboBoxAdv.RowSource = "confidential!Report_OShea"
    
    Case "Taylor"
    
    ComboBoxAdv.RowSource = "confidential!Report_taylor"
    
    Case "Keighley"
    
    ComboBoxAdv.RowSource = "confidential!Report_Keighley"
    
    Case "Winback"
    
    ComboBoxAdv.RowSource = "confidential!Report_Winback"
    
    Case Else
    
    Me.ComboBoxAdv.Value = "Select Team"
    
    End Select
End Sub

Finally here is the formulae i am using to generate results from submitted data

Cell E3 worksheets("ReportData") =IF(B3="All",SUMPRODUCT(--('S:\[STB Data.xlsx]STB Data'!$B:$B>=C3),--('S:\[STB Data.xlsx]STB Data'!$B:$B<=D3),'S:\[STB Data.xlsx]STB Data'!$J:$J,--('S:\[STB Data.xlsx]STB Data'!$D:$D=A3)),SUMPRODUCT(--('S:\[STB Data.xlsx]STB Data'!$B:$B>=C3),--('S:\[STB Data.xlsx]STB Data'!$B:$B<=D3),'S:\[STB Data.xlsx]STB Data'!$J:$J,--('S:\[STB Data.xlsx]STB Data'!$C:$C=B3)))

Cell F3 worksheets("ReportData") =IF(B3="All",SUMPRODUCT(--('S:\[STB Data.xlsx]STB Data'!$I:$I>=C3),--('S:\[STB Data.xlsx]STB Data'!$I:$I<=D3),'S:\[STB Data.xlsx]STB Data'!$K:$K,--('S:\[STB Data.xlsx]STB Data'!$D:$D=A3)),SUMPRODUCT(--('S:\[STB Data.xlsx]STB Data'!$I:$I>=C3),--('S:\[STB Data.xlsx]STB Data'!$I:$I<=D3),'S:\[STB Data.xlsx]STB Data'!$K:$K,--('S:\[STB Data.xlsx]STB Data'!$C:$C=B3)))

HTH

Thanks for your time guys.
 
Upvote 0
Hi Guys,

Any response would be appreciated as i have a deadline today for 17:00 GMT.

Please please any assistance welcome.
 
Upvote 0
Hello,

I have an extension on this project until 19:00 GMT.

I have reread my original post and realised that i may have caused some confusion when stating "*i dont have access", what i meant was that i do not have MS Access available to me, i do have access to the workbook.

Regards,
 
Upvote 0

Forum statistics

Threads
1,223,725
Messages
6,174,128
Members
452,546
Latest member
Rafafa

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