Comparing ARRAY elements with RANGE data and created a 2nd array

  • Thread starter Thread starter JimP
  • Start date Start date
J

JimP

To All,

I create an array from a single column of data.(range name =
OT_INITIALS. I then use the elements of the array SeniorityArr(),
starting at the lower bound thru the upper bound. I search to see if
the ARRAY's stored data (2 initials per element) exists in a second
Range of data called INITIALS (on a different sheet).
If the arrays' element is found within Range "INITIALS", I then check
the 31 columns of data "offset" to the right (1-31) of INITIALS.

I search for an EMBEDDED "T" character, indicating "TRAINING". If the
"T" is found (using InStr), I add the INITIALS to a 2nd array called
TrainingArr(). TrainingArr() is "ReDim Preserve" to not lose the data
from the prior Tests!

Upon completion of looping thru all elements of SeniorityArr(), I
should have a second Array that contains only the INITIALS of those
individuals who are receiving Training. (list will, by default, be in
Seniority order.)

Currently, I'm having no trouble with Steps 1 and 2, but can't for the
life of me, get the 3rd step to work properly.
Getting a constant error: RUNTIME ERROR TYPE MISMATCH?

Any Help would be greatly appreciated!!!

Jim Pellechi

'''''''''''''''''''''''''''''''
Sub Build_Training_Report()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Step1) 'BUILD ARRAY
Dim SeniorityArr() As Variant
SeniorityArr() = Application.Transpose(Range("OT_INITIALS"))
'Step2) '-----------------
Dim SeniorityTotal As Integer
SeniorityTotal = UBound(SeniorityArr, 1) - LBound(SeniorityArr, 1)
+ 1
'----------------------------
' NOW build a Training Report using the Seniority Array as a
Reference
'----------------------------
Dim Rpt As String: Rpt = ""
Dim x As Integer
Dim TrainingArr() As Variant
Dim cell As Range
Dim Oper_Initials As String
'-----
For x = LBound(SeniorityArr, 1) To SeniorityTotal
'Step 3)
For Each cell In Range("INITIALS")
Oper_Initials = CStr(SeniorityArr(x))
If cell.Value = Oper_Initials Then
'THINK NEXT LINE IS PROBLEM ... RUNTIME ERROR TYPE MISMATCH?
If InStr(cell(cell.Offset(0, 1), cell.Offset(0, 31)), "T", 1)
Then
MsgBox ("Training: " & Range("Oper_Initials").Value)
ReDim Preserve TrainingArr(x) ' Build Training Array
TrainingArr(x) = SeniorityArr(x) ' FOUND someone Training
End If
'Do Nothing
End If
Next

'----------------------------
Dim TrainingTotal As Integer
TrainingTotal = UBound(TrainingArr, 1) - LBound(TrainingArr, 1) + 1
'----------------------------
SeniorityRpt = SeniorityRpt & "Total:" & SeniorityTotal
MsgBox (SeniorityRpt & vbCrLf & "TrainingTotal = " & TrainingTotal)

End Sub
 
Jim,

Assumption - you're looking for a cell with just a T, not something like Tr.
or Training....

Try replacing:

If InStr(cell(cell.Offset(0, 1), cell.Offset(0, 31)), "T", 1) Then

with

If Not cell.Resize(1, 31).Find("T", , xlValues, xlWhole) Is Nothing Then
MsgBox "Found a T in the 31 columns to the right"
'Code that you use when you find a T
Else
MsgBox "Did not find a T in the 31 columns to the right"
End If

HTH,
Bernie
MS Excel MVP
 
Bernie,

Thanks for replying ... needed 3 minor tweaks to complete your
suggestion/direction,
1) A seperate index to apply to the Training ARRAY ... I now use 't' and
2) I had to Offset 1 char to the right to identify the range 1-31, otherwise
I was searching the INITIALS themselves and
3) xlWhole was changed to xlPart to FIND embedded 'T' 's ....

Now it's working perfectly ... THANKS A MILLION

JimP
''''''''''''''''''''''''''''''''''''''''''''''
If Not cell.Offset(0, 1).Resize(1, 31).Find("T", , xlValues,
xlPart) _
Is Nothing Then
t = t + 1
ReDim Preserve TrainingArr(t)
TrainingArr(t) = SeniorityArr(s)
Exit For
End If

''''''''''''''''''''''''''''''''''''''''''''''
 
Back
Top