M
Mike
I have tried to write this Array Formula several ways but still get the
error. Maybe one of you sharp eyed gurus can see it, but I don't.
The formula is a basic CountIf with multiple criteria in the form of
{SUM((rngA=X)*(rngB=y))}.
Sub Tech_Codes()
Dim myrng As Range, myrng2 As Range, myrng3 As Range, myrng4 As Range
Dim rwct2 As Integer, c As Integer, rwct3 As Integer
Sheets(db1).Activate
Range("A1").Activate
rwct2 = ActiveCell.CurrentRegion.Rows.Count 'Get REPTECH Range for
AdvancedFilter
Range("I2:I" & rwct2).Formula = "= Text(G2,0)"
Range("I2:I" & rwct2).Copy
Range("G2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Range("G1:G" & rwct2).AdvancedFilter Action:=xlFilterCopy,
copytorange:=Range("J1"), unique:=True
Range("I1:I" & rwct2).ClearContents
Columns("J:J").Activate
Selection.Sort Key1:=Range("J2"), order1:=xlAscending, Header:=xlGuess,
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
If Range("J2") = "0" Then
Range("J2").Delete
Else
End If
ActiveCell.CurrentRegion.Select
rwct = Selection.Rows.Count 'Count of unique REPTECHs +1
Set myrng = Range("J2:J" & rwct)
Set myrng2 = Range("$G$2:$G$" & rwct2)
Set myrng4 = Range("$H$2:$H$" & rwct2)
Sheets("QData").Activate
Range(Cells(20, 2), (Cells(20, rwct))).FormulaArray =
Application.WorksheetFunction.Transpose(myrng)
Range(Cells(20, 2), (Cells(20, 2))).Activate
rwct3 = ActiveCell.CurrentRegion.Rows.Count - 2
For c = 2 To rwct
Set myrng = Range(Cells(21, c), (Cells(20 + rwct3, c))) ' set variable to
a new range
Set myrng3 = Range(Cells(20, c), (Cells(20, c)))
myrng.FormulaArray = Application.WorksheetFunction.Sum((myrng2 = myrng3) *
(myrng4 = Range("G2")))
'Type Mismatch on line above
Next c
End Sub
My boss thanks you in advance ( and of course, me 2)
error. Maybe one of you sharp eyed gurus can see it, but I don't.
The formula is a basic CountIf with multiple criteria in the form of
{SUM((rngA=X)*(rngB=y))}.
Sub Tech_Codes()
Dim myrng As Range, myrng2 As Range, myrng3 As Range, myrng4 As Range
Dim rwct2 As Integer, c As Integer, rwct3 As Integer
Sheets(db1).Activate
Range("A1").Activate
rwct2 = ActiveCell.CurrentRegion.Rows.Count 'Get REPTECH Range for
AdvancedFilter
Range("I2:I" & rwct2).Formula = "= Text(G2,0)"
Range("I2:I" & rwct2).Copy
Range("G2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Range("G1:G" & rwct2).AdvancedFilter Action:=xlFilterCopy,
copytorange:=Range("J1"), unique:=True
Range("I1:I" & rwct2).ClearContents
Columns("J:J").Activate
Selection.Sort Key1:=Range("J2"), order1:=xlAscending, Header:=xlGuess,
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
If Range("J2") = "0" Then
Range("J2").Delete
Else
End If
ActiveCell.CurrentRegion.Select
rwct = Selection.Rows.Count 'Count of unique REPTECHs +1
Set myrng = Range("J2:J" & rwct)
Set myrng2 = Range("$G$2:$G$" & rwct2)
Set myrng4 = Range("$H$2:$H$" & rwct2)
Sheets("QData").Activate
Range(Cells(20, 2), (Cells(20, rwct))).FormulaArray =
Application.WorksheetFunction.Transpose(myrng)
Range(Cells(20, 2), (Cells(20, 2))).Activate
rwct3 = ActiveCell.CurrentRegion.Rows.Count - 2
For c = 2 To rwct
Set myrng = Range(Cells(21, c), (Cells(20 + rwct3, c))) ' set variable to
a new range
Set myrng3 = Range(Cells(20, c), (Cells(20, c)))
myrng.FormulaArray = Application.WorksheetFunction.Sum((myrng2 = myrng3) *
(myrng4 = Range("G2")))
'Type Mismatch on line above
Next c
End Sub
My boss thanks you in advance ( and of course, me 2)