I am using scripting dictionary method -If no data - need a message box -

Dim x, y(), i&, j&, k&, l&, s$
x = Range("C1:I" & Cells(Rows.Count, 3).End(xlUp).Row).Value
ReDim y(1 To UBound(x), 1 To 5)

With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(x)
                If x(i, 4) = "Overtime" Or x(i, 4) = "Overtime On Saturday" Or x(i, 4) = "Overtime On Sunday" Or x(i, 4) = "Saturday Premium" Or x(i, 4) = "Sunday Premium" Or x(i, 4) = "Travel" Or x(i, 4) = "Travel Saturday" Or x(i, 4) = "Travel Sunday/Holiday" Then
            s = x(i, 2) & x(i, 4)    'BEMSID&HOURS_DESCR is the unique key
            'if key already exists in the dictionary, we sum AMOUNT
            If .exists(s) Then
                k = .Item(s): y(k, 5) = y(k, 5) + x(i, 7)    'y(k, 5) is 'AMOUNT'
            Else 'if key not exists
                j = j + 1: .Item(s) = j 'add key in the dictionary,
                ' and fill the output array
                y(j, 1) = x(i, 2): y(j, 2) = x(i, 1) 'column BEMSID
                y(j, 2) = Split(x(i, 1), ",")(0)  'column EMPLOYEE, surname only
                y(j, 3) = x(i, 4): y(j, 4) = x(i, 7) 'column HOURS_DESCR
                y(j, 4) = "" 'column Value, 
                y(j, 5) = x(i, 7)    'column AMOUNT (Units)
            End If
        End If
    Next i
End With
If j = 0 Then Exit Sub

So this is my code as above, but what it there is nothing in the data when I open the file ? It doesn't do anything apart from open the data file to extract the info from so how can I put something in here to say if no results obtained then have a message box appear to say "no data to import this month" and to exit the sub....

Many thanks in advance
Leanne

Hey,

Try this,

Dim x, y(), i&, j&, k&, l&, s$
x = Range("C1:I" & Cells(Rows.Count, 3).End(xlUp).Row).Value
ReDim y(1 To UBound(x), 1 To 5)
  On Error Goto ErrHandler
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(x)
                If x(i, 4) = "Overtime" Or x(i, 4) = "Overtime On Saturday" Or x(i, 4) = "Overtime On Sunday" Or x(i, 4) = "Saturday Premium" Or x(i, 4) = "Sunday Premium" Or x(i, 4) = "Travel" Or x(i, 4) = "Travel Saturday" Or x(i, 4) = "Travel Sunday/Holiday" Then
            s = x(i, 2) & x(i, 4)    'BEMSID&HOURS_DESCR is the unique key
            'if key already exists in the dictionary, we sum AMOUNT
            If .exists(s) Then
                k = .Item(s): y(k, 5) = y(k, 5) + x(i, 7)    'y(k, 5) is 'AMOUNT'
            Else 'if key not exists
                j = j + 1: .Item(s) = j 'add key in the dictionary,
                ' and fill the output array
                y(j, 1) = x(i, 2): y(j, 2) = x(i, 1) 'column BEMSID
                y(j, 2) = Split(x(i, 1), ",")(0)  'column EMPLOYEE, surname only
                y(j, 3) = x(i, 4): y(j, 4) = x(i, 7) 'column HOURS_DESCR
                y(j, 4) = "" 'column Value, 
                y(j, 5) = x(i, 7)    'column AMOUNT (Units)
            End If
        End If
    Next i
End With
If j = 0 Then Exit Sub
ErrHandler:
             MsgBox "No data to import this month"
Exit Sub

Can you post the whole code?

Try this,

Option Explicit
Dim Filesavename As String
Dim WeeklyFN As String
Dim MainFN As String
Dim MFile As String
Dim lrow As Long
Dim sfield As String
Dim cellcol As Long
Dim i As Long
Dim lastrow As Long
Dim rownumber As Long
Dim c As Object
Dim iReply As String
Dim iReply1 As String
Dim cel As Range




Sub SP()



MFile = ActiveWorkbook.Name
Application.ScreenUpdating = False
proceed:
WeeklyFN = Application.GetOpenFilename(fileFilter:="All files (*.*), *.*", Title:="Please open the GT Feed")
If WeeklyFN = "" Then
    MsgBox "You have not selected a file."
    GoTo proceed
Else
    Workbooks.Open Filename:=WeeklyFN
    WeeklyFN = ActiveWorkbook.Name
End If
 Columns("D:D").Select
    Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True

'Workbooks.Open Filename:= _
        "N:\PAYROLL\Leanne\LM\GT FEED.xls"
   'get row count
    Range("A1").Select
    Selection.End(xlDown).Select
    rownumber = ActiveCell.Row
 Range("A1").Select
    Cells.Find(What:="BEMSID", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        Set cel = Cells.Find(What:="BEMSID", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
         If cel = "" Then
           ActiveWorkbook.Close False
            GoTo nxt
         End If
        
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    
    Range("D2").Select
 
 Dim x, y(), i&, j&, k&, l&, s$
'x is the original array with the data. It starts from column C to column I, the length of
'the array - from row 1 to the last filled cell in column C
x = Range("C1:I" & Cells(Rows.Count, 3).End(xlUp).Row).Value
'y is the output array, '1 to 5' means that it contains 5 columns
ReDim y(1 To UBound(x), 1 To 5)

With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(x)
        'if values in column H on the sheet = ...
        If x(i, 4) = "Overtime" Or x(i, 4) = "Overtime On Saturday" Or x(i, 4) = "Overtime On Sunday" Or x(i, 4) = "Saturday Premium" Or x(i, 4) = "Sunday Premium" Or x(i, 4) = "Travel" Or x(i, 4) = "Travel Saturday" Or x(i, 4) = "Travel Sunday/Holiday" Then
            s = x(i, 2) & x(i, 4)    'BEMSID&HOURS_DESCR is the unique key
            'if key already exists in the dictionary, we sum AMOUNT
            If .exists(s) Then
                k = .Item(s): y(k, 5) = y(k, 5) + x(i, 7)    'y(k, 5) is 'AMOUNT'
            Else 'if key not exists
                j = j + 1: .Item(s) = j 'add key in the dictionary,
                ' and fill the output array
                y(j, 1) = x(i, 2): y(j, 2) = x(i, 1) 'column BEMSID
                y(j, 2) = Split(x(i, 1), ",")(0)  'column EMPLOYEE, surname only
                y(j, 3) = x(i, 4): y(j, 4) = x(i, 7) 'column HOURS_DESCR
                y(j, 4) = "" 'column Value, not clear-need column to be blank so ok
                y(j, 5) = x(i, 7)    'column AMOUNT (Units)
            End If
        End If
    Next i
End With
If j = 0 Then Exit Sub
ErrHandler:
             MsgBox "No data to import this month"
Exit Sub
                
Windows("LM.xlsm").Activate
Sheet2.Activate
'Workbooks.Open Filename:="N:\PAYROLL\Leanne\LM\FILE TO IMPORT.xlsx"
'Workbooks.Open Filename:=ThisWorkbook.Path & "\FILE TO IMPORT.xlsx" 'or so, if all files are in same folder
With Sheets(2)
    .UsedRange.ClearContents
    .Columns(1).NumberFormat = "@"
    .[a1:e1].Value = Array("BEMSID", "EMPLOYEE", "HOURS_DESCR", "AMOUNT", "UNITS")
    .[a2:e2].Resize(j).Value = y()
   
    
End With
  
  Application.DisplayAlerts = False

    
    'sFileNames = Application.GetSaveAsFilename(fileFilter:="All files (*.*), *.*", Title:="Please save import template")
      'If sFileNames = "False" Then Exit Sub

    'get row count
    Range("A1").Select
    Selection.End(xlDown).Select
    rownumber = ActiveCell.Row
    
    Range("A1").Select
    
    Columns("A:E").Select
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("C2:C90") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet2").Sort
        .SetRange Range("A1:E" & rownumber)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    Sheet1.Select
    


       Exit Sub
    
    Windows("LM.xlsm").Activate
    Sheet1.Select
   MsgBox (iReply = "Select 2nd Step of Macro Process")
nxt:
  MsgBox "No data was found"
End Sub

Try This,

Option Explicit
Dim Filesavename As String
Dim WeeklyFN As String
Dim MainFN As String
Dim MFile As String
Dim lrow As Long
Dim sfield As String
Dim cellcol As Long
Dim i As Long
Dim lastrow As Long
Dim rownumber As Long
Dim c As Object
Dim iReply As String
Dim iReply1 As String
Dim cel As Variant




Sub SP()



MFile = ActiveWorkbook.Name
Application.ScreenUpdating = False
proceed:
WeeklyFN = Application.GetOpenFilename(fileFilter:="All files (*.*), *.*", Title:="Please open the GT Feed")
If WeeklyFN = "" Then
    MsgBox "You have not selected a file."
    GoTo proceed
Else
    Workbooks.Open Filename:=WeeklyFN
    WeeklyFN = ActiveWorkbook.Name
End If
 Columns("D:D").Select
    Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True

'Workbooks.Open Filename:= _
        "N:\PAYROLL\Leanne\LM\GT FEED.xls"
   'get row count
    Range("A1").Select
    Selection.End(xlDown).Select
    rownumber = ActiveCell.Row
 Range("A1").Select
    Cells.Find(What:="BEMSID", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        cel = Cells.Find(What:="BEMSID", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
         If cel = "" Then
           ActiveWorkbook.Close False
            GoTo nxt
         End If
        
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    
    Range("D2").Select
 
 Dim x, y(), i&, j&, k&, l&, s$
'x is the original array with the data. It starts from column C to column I, the length of
'the array - from row 1 to the last filled cell in column C
x = Range("C1:I" & Cells(Rows.Count, 3).End(xlUp).Row).Value
'y is the output array, '1 to 5' means that it contains 5 columns
ReDim y(1 To UBound(x), 1 To 5)

With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(x)
        'if values in column H on the sheet = ...
        If x(i, 4) = "Overtime" Or x(i, 4) = "Overtime On Saturday" Or x(i, 4) = "Overtime On Sunday" Or x(i, 4) = "Saturday Premium" Or x(i, 4) = "Sunday Premium" Or x(i, 4) = "Travel" Or x(i, 4) = "Travel Saturday" Or x(i, 4) = "Travel Sunday/Holiday" Then
            s = x(i, 2) & x(i, 4)    'BEMSID&HOURS_DESCR is the unique key
            'if key already exists in the dictionary, we sum AMOUNT
            If .exists(s) Then
                k = .Item(s): y(k, 5) = y(k, 5) + x(i, 7)    'y(k, 5) is 'AMOUNT'
            Else 'if key not exists
                j = j + 1: .Item(s) = j 'add key in the dictionary,
                ' and fill the output array
                y(j, 1) = x(i, 2): y(j, 2) = x(i, 1) 'column BEMSID
                y(j, 2) = Split(x(i, 1), ",")(0)  'column EMPLOYEE, surname only
                y(j, 3) = x(i, 4): y(j, 4) = x(i, 7) 'column HOURS_DESCR
                y(j, 4) = "" 'column Value, not clear-need column to be blank so ok
                y(j, 5) = x(i, 7)    'column AMOUNT (Units)
            End If
        End If
    Next i
End With
If j = 0 Then Exit Sub
ErrHandler:
             MsgBox "No data to import this month"
Exit Sub
                
Windows("LM.xlsm").Activate
Sheet2.Activate
'Workbooks.Open Filename:="N:\PAYROLL\Leanne\LM\FILE TO IMPORT.xlsx"
'Workbooks.Open Filename:=ThisWorkbook.Path & "\FILE TO IMPORT.xlsx" 'or so, if all files are in same folder
With Sheets(2)
    .UsedRange.ClearContents
    .Columns(1).NumberFormat = "@"
    .[a1:e1].Value = Array("BEMSID", "EMPLOYEE", "HOURS_DESCR", "AMOUNT", "UNITS")
    .[a2:e2].Resize(j).Value = y()
   
    
End With
  
  Application.DisplayAlerts = False

    
    'sFileNames = Application.GetSaveAsFilename(fileFilter:="All files (*.*), *.*", Title:="Please save import template")
      'If sFileNames = "False" Then Exit Sub

    'get row count
    Range("A1").Select
    Selection.End(xlDown).Select
    rownumber = ActiveCell.Row
    
    Range("A1").Select
    
    Columns("A:E").Select
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("C2:C90") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet2").Sort
        .SetRange Range("A1:E" & rownumber)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    Sheet1.Select
    


       Exit Sub
    
    Windows("LM.xlsm").Activate
    Sheet1.Select
   MsgBox (iReply = "Select 2nd Step of Macro Process")
nxt:
  MsgBox "No data was found"
End Sub

Are you trying to exit if the file you open has no data in it? If so, check if C1 is blank.

Then I suspect you simply want to check the Count of the dictionary and exit if 0?

Well actually, looking at your code, you already have

If j = 0 Then Exit Sub

so you just need to add a message box

If j = 0 Then
 Msgbox "No data to add this month"
 Exit Sub
End If