D
DogLover
All this code works perfectly except when I try to add specifically the field
mEntityCriteria with mEntityRange. I cannot get it to calculate correct, and
now I'm getting an Error 13 Data Type Mismatch of this line of code in
mformula.
Can anyone spot something wrong??? Please help.
Private Sub VBATEST_Click()
Dim mTimeCriteria As String
Dim mPositionCriteria As String
Dim mEntityCriteria As String
Dim mStatusCriteria As String
Dim mBeginDateCriteria As Variant
Dim mEndDateCriteria As Variant
Dim mQuestion1Criteria As String
Dim Kountifs As Long
Dim mTimeRange As Range
Dim mPositionRange As Range
Dim mEntityRange As Range
Dim mOrientMoYrRange As Range
Dim mStatusRange As Range
Dim mQuestion1Range As Range
Dim mFormula As String
Dim mBegMo As Integer, mBegYr As Integer
Dim mEndMo As Integer, mEndYr As Integer
'mPositionCriteria = mPositionC ' This line of Code allows automatic
RECALCULATION
'mEntityCriteria = mEntityC
'mBeginDateCriteria = mBeginDateC
'mEndDateCriteria = mEndDateC
'mStatusCriteria = mStatusC
' Needed if Subroutine vs Functio, change to passing variable later
mPositionCriteria = Worksheets("RFJ").Range("N6")
mEntityCriteria = Worksheets("RFJ").Range("N7")
mBeginDateCriteria = Worksheets("RFJ").Range("N8")
mEndDateCriteria = Worksheets("RFJ").Range("N9")
mStatusCriteria = Worksheets("RFJ").Range("N10")
mBegMo = Month(mBeginDateCriteria)
mBegYr = Year(mBeginDateCriteria)
If Month(mEndDateCriteria) = 12 Then
mEndMo = 1
mEndYr = Year(mBeginDateCriteria) + 1
Else
mEndMo = Month(mEndDateCriteria) + 1
mEndYr = Year(mBeginDateCriteria)
End If
' Set Criterias
mBeginDateCriteria = ">=" & "DATE(" & mBegYr & "," & mBegMo & ",1)"
mEndDateCriteria = "<" & "DATE(" & mEndYr & "," & mEndMo & ",1)"
mTimeCriteria = "=" & Chr(34) & "First day of employment (Time 1)" & Chr(34)
mQuestion1Criteria = "<>" & Chr(34) & "*" & Chr(34)
'Position Criteria
If mPositionCriteria = "<>" Then
mPositionCriteria = "<>" & Chr(34) & "*" & Chr(34) ' ALL Records
Else
mPositionCriteria = "=" & Chr(34) & mPositionCriteria & Chr(34)
End If
'Entity Criteria
If mEntityCriteria = "<>" Then
mEntityCriteria = "<>" & Chr(34) & "*" & Chr(34) ' ALL Records
Else
mEntityCriteria = "=" & Chr(34) & mEntityCriteria & Chr(34)
End If
'Status Criteria
If mStatusCriteria = "<>" Then
mStatusCriteria = "<>" & Chr(34) & "*" & Chr(34) ' ALL Records
Else
mStatusCriteria = "=" & Chr(34) & mStatusCriteria & Chr(34)
End If
'
With Worksheets("Data")
Set mTimeRange = .Range("DataTime")
Set mPositionRange = .Range("DataPosition")
Set mEntityRange = .Range("DataEntity")
Set mOrientMoYrRange = .Range("DataOrientMoYr")
Set mStatusRange = .Range("DataStatus")
Set mQuestion1Range = .Range("DataQuestion1")
MsgBox mPositionCriteria
MsgBox mEntityCriteria
mFormula = "SUMPRODUCT(--(" & mTimeRange.Address & mTimeCriteria & "),"
mFormula = mFormula & "--(" & mPositionRange.Address & "=" & Chr(34) &
"mPositionCriteria" & Chr(34) & "),"
mFormula = mFormula & "--(" & mEntityRange.Address & "=" & Chr(34) &
"CRMC - Community Regional Medical Center" & Chr(34) & "),"
mFormula = mFormula & "--(" & mOrientMoYrRange.Address &
mBeginDateCriteria & "),"
mFormula = mFormula & "--(" & mOrientMoYrRange.Address &
mEndDateCriteria & "),"
mFormula = mFormula & "--(" & mStatusRange.Address & mStatusCriteria &
"),"
mFormula = mFormula & "-- (" & mQuestion1Range.Address &
mQuestion1Criteria & ") )"
'mFormula = mFormula & mQuestion1Range.Address & ")" 'This sums
correctly
Kountifs = .Evaluate(mFormula)
End With
If IsError(Kountifs) Then
MsgBox "Error in evaluating"
End If
MsgBox Kountifs
End Sub
mEntityCriteria with mEntityRange. I cannot get it to calculate correct, and
now I'm getting an Error 13 Data Type Mismatch of this line of code in
mformula.
Can anyone spot something wrong??? Please help.
Private Sub VBATEST_Click()
Dim mTimeCriteria As String
Dim mPositionCriteria As String
Dim mEntityCriteria As String
Dim mStatusCriteria As String
Dim mBeginDateCriteria As Variant
Dim mEndDateCriteria As Variant
Dim mQuestion1Criteria As String
Dim Kountifs As Long
Dim mTimeRange As Range
Dim mPositionRange As Range
Dim mEntityRange As Range
Dim mOrientMoYrRange As Range
Dim mStatusRange As Range
Dim mQuestion1Range As Range
Dim mFormula As String
Dim mBegMo As Integer, mBegYr As Integer
Dim mEndMo As Integer, mEndYr As Integer
'mPositionCriteria = mPositionC ' This line of Code allows automatic
RECALCULATION
'mEntityCriteria = mEntityC
'mBeginDateCriteria = mBeginDateC
'mEndDateCriteria = mEndDateC
'mStatusCriteria = mStatusC
' Needed if Subroutine vs Functio, change to passing variable later
mPositionCriteria = Worksheets("RFJ").Range("N6")
mEntityCriteria = Worksheets("RFJ").Range("N7")
mBeginDateCriteria = Worksheets("RFJ").Range("N8")
mEndDateCriteria = Worksheets("RFJ").Range("N9")
mStatusCriteria = Worksheets("RFJ").Range("N10")
mBegMo = Month(mBeginDateCriteria)
mBegYr = Year(mBeginDateCriteria)
If Month(mEndDateCriteria) = 12 Then
mEndMo = 1
mEndYr = Year(mBeginDateCriteria) + 1
Else
mEndMo = Month(mEndDateCriteria) + 1
mEndYr = Year(mBeginDateCriteria)
End If
' Set Criterias
mBeginDateCriteria = ">=" & "DATE(" & mBegYr & "," & mBegMo & ",1)"
mEndDateCriteria = "<" & "DATE(" & mEndYr & "," & mEndMo & ",1)"
mTimeCriteria = "=" & Chr(34) & "First day of employment (Time 1)" & Chr(34)
mQuestion1Criteria = "<>" & Chr(34) & "*" & Chr(34)
'Position Criteria
If mPositionCriteria = "<>" Then
mPositionCriteria = "<>" & Chr(34) & "*" & Chr(34) ' ALL Records
Else
mPositionCriteria = "=" & Chr(34) & mPositionCriteria & Chr(34)
End If
'Entity Criteria
If mEntityCriteria = "<>" Then
mEntityCriteria = "<>" & Chr(34) & "*" & Chr(34) ' ALL Records
Else
mEntityCriteria = "=" & Chr(34) & mEntityCriteria & Chr(34)
End If
'Status Criteria
If mStatusCriteria = "<>" Then
mStatusCriteria = "<>" & Chr(34) & "*" & Chr(34) ' ALL Records
Else
mStatusCriteria = "=" & Chr(34) & mStatusCriteria & Chr(34)
End If
'
With Worksheets("Data")
Set mTimeRange = .Range("DataTime")
Set mPositionRange = .Range("DataPosition")
Set mEntityRange = .Range("DataEntity")
Set mOrientMoYrRange = .Range("DataOrientMoYr")
Set mStatusRange = .Range("DataStatus")
Set mQuestion1Range = .Range("DataQuestion1")
MsgBox mPositionCriteria
MsgBox mEntityCriteria
mFormula = "SUMPRODUCT(--(" & mTimeRange.Address & mTimeCriteria & "),"
mFormula = mFormula & "--(" & mPositionRange.Address & "=" & Chr(34) &
"mPositionCriteria" & Chr(34) & "),"
mFormula = mFormula & "--(" & mEntityRange.Address & "=" & Chr(34) &
"CRMC - Community Regional Medical Center" & Chr(34) & "),"
mFormula = mFormula & "--(" & mOrientMoYrRange.Address &
mBeginDateCriteria & "),"
mFormula = mFormula & "--(" & mOrientMoYrRange.Address &
mEndDateCriteria & "),"
mFormula = mFormula & "--(" & mStatusRange.Address & mStatusCriteria &
"),"
mFormula = mFormula & "-- (" & mQuestion1Range.Address &
mQuestion1Criteria & ") )"
'mFormula = mFormula & mQuestion1Range.Address & ")" 'This sums
correctly
Kountifs = .Evaluate(mFormula)
End With
If IsError(Kountifs) Then
MsgBox "Error in evaluating"
End If
MsgBox Kountifs
End Sub