Changing destination sheet using VBA

I have the below code that will count certain strings based on date range and update the count in a cell in sheet named “Latency”.

I’m not sure how to do the below task:

1. Currently the count is pasted in “latency” sheet, But I want to paste it in Sheet named “MySheet”
2. How do i add multiple criteria from multiple rows? Currently its just for “COMPATIBLE” in “E”, what if I need to add additional criteria for “XYZ” in “X” column?

Option Explicit
Const strFormTitle = "Enter Minimum and Maximum Dates in d/m/yyyy format"  'Edit for different regional date format
Const strShtName As String = "Latency"              'Name of worksheet with ranges to be processed
Const strDateFormat As String = "d mmm yyyy"       'Edit for different regional date format
Const strCrit1 As String = "Pass, Fail, In Progress"    'Criteria for output to AE2. (Can insert or delete criteria with comma between values. OK to have spaces with the commas)
Const strCrit2 As String = "COMPATIBLE"     'Criteria for column E. (One criteria only)
Const strDateRng As String = "K:K"      'Column with Dates
Const strCrit1Col As String = "O:O"     'Column with "Pass, Fail, In Progress"
Const strCrit2Col As String = "E:E"     'Column with "COMPATIBLE"
Const strOutput1 As String = "AE2"      'The cell for output "Pass, Fail, In Progress"
Const strOutput2 As String = "AF2"      'The cell for output "Pass, Fail, In Progress" plus "COMPATIBLE"
Private Sub UserForm_Initialize()
Me.lblTitle = strFormTitle
End Sub


Private Sub cmdProcess_Click()
Dim wf As WorksheetFunction
Dim ws As Worksheet
Dim rngDates As Range 'Range of dates
Dim rngCrit1 As Range 'Range to match Criteria 1
Dim rngCrit2 As Range 'Range to match Criteria 2
Dim dteMin As Date
Dim dteMax As Date
Dim rngOutput1 As Range
Dim rngOutput2 As Range
Dim arrSplit As Variant
Dim i As Long

Set wf = Application.WorksheetFunction
Set ws = Worksheets(strShtName)
With ws
Set rngDates = .Columns(strDateRng)
Set rngOutput1 = .Range(strOutput1)
Set rngOutput2 = .Range(strOutput2)
Set rngCrit1 = .Range(strCrit1Col)
Set rngCrit2 = .Range(strCrit2Col)
End With

dteMin = CDate(Me.txtMinDate)
dteMax = Int(CDate(Me.txtMaxDate) + 1)

If dteMin > dteMax Then
MsgBox "Minimum date must be less than maximum date." & vbCrLf & _
"Please re-enter a valid dates."
Exit Sub
End If

arrSplit = Split(strCrit1, ",")

'Following loop removes any additional leading or trailing spaces (Can be in the string constant)
For i = LBound(arrSplit) To UBound(arrSplit)
arrSplit(i) = Trim(arrSplit(i))
Next i

rngOutput1.ClearContents 'Start with blank cell
For i = LBound(arrSplit) To UBound(arrSplit)
rngOutput1.Value = rngOutput1.Value + wf.CountIfs(rngDates, ">=" & CLng(dteMin), _
rngDates, "<" & CLng(dteMax), _ rngCrit1, arrSplit(i)) Next i rngOutput2.ClearContents 'Start with blank cell For i = LBound(arrSplit) To UBound(arrSplit) rngOutput2.Value = rngOutput2.Value + wf.CountIfs(rngDates, ">=" & CLng(dteMin), _
rngDates, "<" & CLng(dteMax), _ rngCrit1, arrSplit(i), rngCrit2, strCrit2) Next i End Sub Private Sub cmdCancel_Click() Unload Me End Sub [/code] [code] Private Sub txtMinDate_AfterUpdate() If IsDate(Me.txtMinDate) Then Me.txtMinDate = Format(CDate(Me.txtMinDate), strDateFormat) Else MsgBox "Invalid Minimum date. Please re-enter a valid date." End If End Sub Private Sub txtMaxDate_AfterUpdate() If IsDate(Me.txtMaxDate) Then Me.txtMaxDate = Format(CDate(Me.txtMaxDate), strDateFormat) Else MsgBox "Invalid Maximum date. Please re-enter a valid date." End If End Sub Private Sub chkEntireRng_Click() Dim wf As WorksheetFunction Dim ws As Worksheet Dim rngDates As Range Set wf = WorksheetFunction Set ws = Worksheets(strShtName) With ws Set rngDates = .Columns(strDateRng) End With If Me.chkEntireRng = True Then Me.txtMinDate = Format(wf.Min(rngDates), strDateFormat) Me.txtMaxDate = Format(wf.Max(rngDates), strDateFormat) Me.txtMinDate.Enabled = False Me.txtMaxDate.Enabled = False Else Me.txtMinDate = "" Me.txtMaxDate = "" Me.txtMinDate.Enabled = True Me.txtMaxDate.Enabled = True End If End Sub [/code]

Top Contributor Asked on January 12, 2017 in VBA: User Forms.
Add Comment
0 Answer(s)
  • Found this useful?

    Please share using the share button above.

    If you found the answer is best answer for your question, Please mark as 'best answer' by clicking on the right tick mark icon at the left side of the answer.

    Found the answer useful and wants to credit the user, then vote the answer (vote up).

  • Your Answer

    By posting your answer, you agree to the privacy policy and terms of service.