• Ask a Question
150
Insert Image Size must be less than < 5MB.
    Ask a Question
    Cancel
    150
    More answer You can create 5 answer(s).
      Ask a Poll
      Cancel
      Top Contributor

      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]

      Asked by silverblade on January 12, 2017 in VBA: User Forms.
      0 Answers