PDA

View Full Version : Empty Array gives Run Time Error 13 Type Mismatch



snowbounduk
08-24-2011, 01:38 AM
The following code works fine on every other worksheet except Lessons, which has no data in this instance and stops the script running.

Any suggestions on how to get the code to ignore that there is no data and end the sub?

For Itm = 1 To UBound(MyArr)
ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)

ws.Range("B2:M" & LR).Copy
'Workbooks.Open
Workbooks.Open ("C:\Gordon Reports\tester1\Project RAID" & "\" & MyArr(Itm))
Sheets("Lessons").Range("B12").PasteSpecial xlPasteValues
'Cells.Columns.AutoFit
MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 1

ActiveWorkbook.Save 'As SvPath & MyArr(Itm) & "Issues", xlNormal
ActiveWorkbook.Close False

ws.Range(vTitles).AutoFilter Field:=vCol
Next Itm

Kenneth Hobs
08-24-2011, 01:54 AM
If IsEmpty(MyArr) then Exit Sub

There are more elaborate methods. If IsEmpty() does not suffice, show an example on how MyArr is built.

snowbounduk
08-24-2011, 02:07 AM
I've added IsEmpty but it gives me the same error earlier than previously.

Any help appreciated!

Sub ParseItemsLessonsSP()

Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long
Dim ws As Worksheet, MyArr As Variant, vTitles As String, SvPath As String

Set ws = Sheets("LessonsSP")
SvPath = "C:\Gordon Reports\tester1\files\tester3\"
vTitles = "A1:M1"
vCol = 1
LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row
Application.ScreenUpdating = False
ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True
ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))
If IsEmpty(MyArr) Then Exit Sub
ws.Range("EE:EE").Clear
ws.Range(vTitles).AutoFilter
For Itm = 1 To UBound(MyArr)
ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)

ws.Range("B2:M" & LR).Copy
Workbooks.Open ("C:\Gordon Reports\tester1\Project RAID" & "\" & MyArr(Itm))
Sheets("Lessons").Range("B12").PasteSpecial xlPasteValues
MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 1

ActiveWorkbook.Save
ActiveWorkbook.Close False

ws.Range(vTitles).AutoFilter Field:=vCol
Next Itm

ws.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

Kenneth Hobs
08-24-2011, 05:55 AM
See if the concepts shown here helps. Test on a blank sheet. Notice how I set values for non-continuous data.
Sub t()
Dim MyArr As Variant, ws As Worksheet, eRange As Range, cell As Range, counter As Long
Set ws = ActiveSheet
ws.Range("EE2").Value2 = 1
Set eRange = ws.Range("EE2", ws.Range("EE" & Rows.Count).End(xlUp))
If eRange.Row = 1 Then
MsgBox "Oops, no constants found from EE2 and down.", vbCritical, "Macro Ending"
Exit Sub
End If
eRange.Value2 = Empty
ws.Range("EE3,EE5").Value2 = 1
Set eRange = eRange.SpecialCells(xlCellTypeConstants)
ReDim MyArr(1 To eRange.Cells.Count)
counter = 1
For Each cell In eRange
MyArr(counter) = cell.Value2
counter = counter + 1
Next cell
MsgBox Join(MyArr, vbLf)
End Sub