Assistance with VBA error handling - a cell not matching data set

[willow1985]

I was given the below VBA code and do not fully understand it. It runs when I enter a year in cell A1 on sheet "Score Card".

However if I enter in a year that has no data on sheet "Log" I get a Run-time error 1004: Application-defined or object-defined error.

I would like it if the year entered has no data on sheet "Log" that a Msg box comes up and states "No Data" and exits.

Any help would be appreciated! Thank you

Injury Data All Years.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V
1	2023
2	Safety (Employees)
3	Key Performance Indicator	Operations		Area
4		Target	Actual	Cell	Parking Lot
5	Reportable	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0
6	Non-Reportable	0	2	1	1	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0
7	Near Miss	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0
Score Card

Cell Formulas
Range	Formula
C5:C7	C5	=SUM(D5:X5)
D5:V5	D5	=COUNTIFS(Log[Area],'Score Card'!D4,Log[Year],'Score Card'!$A$1,Log[Reportable/ non-reportable],'Score Card'!$A$5)
D6:V6	D6	=COUNTIFS(Log[Area],'Score Card'!D4,Log[Year],'Score Card'!$A$1,Log[Reportable/ non-reportable],'Score Card'!$A$6)
D7:V7	D7	=COUNTIFS(Log[Area],'Score Card'!D4,Log[Year],'Score Card'!$A$1,Log[Reportable/ non-reportable],'Score Card'!$A$7)

Named Ranges
Name	Refers To	Cells
'Score Card'!Print_Area	='Score Card'!$A$1:$S$51	D5:V7

Injury Data All Years.xlsm
	A	B	C	D	E	F	G	H	I
1	First Name	Last Name	Year	Date	Building	Division	Reportable/ non-reportable	Area	Lost Time
2	M	D	2023	2023-01-06		Un	Non-Reportable	Cell	N
3	T	W	2023	2023-01-05		Un	Non-Reportable	Parking Lot	N
Log

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
G2:G3	Cell Value	="Near Miss"	text	NO
G2:G3	Cell Value	="Non-Reportable"	text	NO
G:G	Cell Value	="Near Miss"	text	NO
G2:G99860	Cell Value	="Non-Reportable"	text	NO

Cells with Data Validation
Cell	Allow	Criteria
E2:E1048576	List	='Graph Data'!$T$2:$T$7
F2:F1048576	List	='Graph Data'!$U$2:$U$13
G2:G1048576	List	='Graph Data'!$W$2:$W$4
H2:H3	List	='Graph Data'!$V$2:$V$40
I2:I1048576	List	='Graph Data'!$X$2:$X$3

Sub SC()
   Dim Cl As Range
   Dim Dic As Object
   Dim Yr As Long
 
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = 1
   Yr = Sheets("Score Card").Range("A1").Value
   With Sheets("Log")
      For Each Cl In .Range("H2", .Range("H" & Rows.Count).End(xlUp))
         If Cl.Offset(, -5).Value = Yr Then Dic(Cl.Value) = Empty
      Next Cl
   End With
   With Sheets("Score Card")
      .Range("D4:AA4").ClearContents
      .Range("D4").Resize(, Dic.Count).Value = Dic.Keys
   End With
   Columns("D:AA").EntireColumn.AutoFit
End Sub

 

[DanteAmor]

Hi @willow1985 and happy new year!!!

Try this:

Sub SC()
   Dim Cl As Range
   Dim Dic As Object
   Dim Yr As Long
   Dim lr As Long
 
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = 1
   Yr = Sheets("Score Card").Range("A1").Value
   With Sheets("Log")
      lr = .Range("H" & Rows.count).End(xlUp).Row
      If lr = 1 Then
        MsgBox "No Data"
        Exit Sub
      End If
      For Each Cl In .Range("H2:H" & lr)
         If Cl.Offset(, -5).Value = Yr Then Dic(Cl.Value) = Empty
      Next Cl
   End With
   With Sheets("Score Card")
      .Range("D4:AA4").ClearContents
      .Range("D4").Resize(, Dic.count).Value = Dic.Keys
   End With
   Columns("D:AA").EntireColumn.AutoFit
End Sub

 

[Anthony47]

Hummm...
I guess the OP was asking for checking that column H does contain any date with the selected year.
For this, I should modify the output portion of the code; for example:

Sub SC()
Dim Cl As Range
Dim Dic As Object
Dim Yr As Long

Set Dic = CreateObject("scripting.dictionary")
Dic.comparemode = 1
Yr = Sheets("Score Card").Range("A1").Value
With Sheets("Log")
   For Each Cl In .Range("H2", .Range("H" & Rows.Count).End(xlUp))
      If Cl.Offset(, -5).Value = Yr Then Dic(Cl.Value) = Empty
   Next Cl
End With
With Sheets("Score Card")
    If Dic.Count > 0 Then
        .Range("D4:AA4").ClearContents
        .Range("D4").Resize(, Dic.Count).Value = Dic.Keys
    Else
        MsgBox ("No data for year=" & Yr)
    End If
End With
Columns("D:AA").EntireColumn.AutoFit
End Sub

 

[DanteAmor]

I guess the OP was asking for checking that column H does contain any date with the selected year.

Good point. In that case, the macro could check the year from the start of the code:

Sub SC()
   Dim Cl As Range
   Dim Dic As Object
   Dim Yr As Long
   Dim f As Range
 
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = 1
   Yr = Sheets("Score Card").Range("A1").Value
   With Sheets("Log")
      Set f = .Range("C:C").Find(Yr, , xlValues, xlWhole)
      If f Is Nothing Then
        MsgBox "No Data"
        Exit Sub
      End If
      For Each Cl In .Range("H2", .Range("H" & Rows.count).End(xlUp))
         If Cl.Offset(, -5).Value = Yr Then Dic(Cl.Value) = Empty
      Next Cl
   End With
   With Sheets("Score Card")
      .Range("D4:AA4").ClearContents
      .Range("D4").Resize(, Dic.count).Value = Dic.Keys
   End With
   Columns("D:AA").EntireColumn.AutoFit
End Sub

 

[willow1985]

Hi @willow1985 and happy new year!!!

Try this:

Sub SC()
   Dim Cl As Range
   Dim Dic As Object
   Dim Yr As Long
   Dim lr As Long
 
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = 1
   Yr = Sheets("Score Card").Range("A1").Value
   With Sheets("Log")
      lr = .Range("H" & Rows.count).End(xlUp).Row
      If lr = 1 Then
        MsgBox "No Data"
        Exit Sub
      End If
      For Each Cl In .Range("H2:H" & lr)
         If Cl.Offset(, -5).Value = Yr Then Dic(Cl.Value) = Empty
      Next Cl
   End With
   With Sheets("Score Card")
      .Range("D4:AA4").ClearContents
      .Range("D4").Resize(, Dic.count).Value = Dic.Keys
   End With
   Columns("D:AA").EntireColumn.AutoFit
End Sub

I am getting an error with your code on line:
Me.Range("D4").Resize(, Dic.Count).Value = Dic.Keys

 

[DanteAmor]

Try the code from post #4

 

[willow1985]

Try the code from post #4

I have tried both of your posts I am afraid and get the same error.

 

[DanteAmor]

That's weird.
In my tests if there is no year 2023, then send the message, we will have to try the option that @Anthony47 put.
Try like this, with double validation:

Sub SC()
   Dim Cl As Range
   Dim dic As Object
   Dim Yr As Long
   Dim f As Range
 
   Set dic = CreateObject("scripting.dictionary")
   dic.comparemode = 1
   Yr = Sheets("Score Card").Range("A1").Value
   With Sheets("Log")
      Set f = .Range("C:C").Find(Yr, , xlValues, xlWhole)
      If f Is Nothing Then
        MsgBox "No Data"
        Exit Sub
      End If
      For Each Cl In .Range("H2", .Range("H" & Rows.count).End(xlUp))
         If Cl.Offset(, -5).Value = Yr Then dic(Cl.Value) = Empty
      Next Cl
   End With
   With Sheets("Score Card")
    If dic.count > 0 Then
      .Range("D4:AA4").ClearContents
      .Range("D4").Resize(, dic.count).Value = dic.Keys
    Else
      MsgBox "No Data, dic empty"
    End If
   End With
   Columns("D:AA").EntireColumn.AutoFit
End Sub

 

[willow1985]

That's weird.
In my tests if there is no year 2023, then send the message, we will have to try the option that @Anthony47 put.
Try like this, with double validation:

Sub SC()
   Dim Cl As Range
   Dim dic As Object
   Dim Yr As Long
   Dim f As Range
 
   Set dic = CreateObject("scripting.dictionary")
   dic.comparemode = 1
   Yr = Sheets("Score Card").Range("A1").Value
   With Sheets("Log")
      Set f = .Range("C:C").Find(Yr, , xlValues, xlWhole)
      If f Is Nothing Then
        MsgBox "No Data"
        Exit Sub
      End If
      For Each Cl In .Range("H2", .Range("H" & Rows.count).End(xlUp))
         If Cl.Offset(, -5).Value = Yr Then dic(Cl.Value) = Empty
      Next Cl
   End With
   With Sheets("Score Card")
    If dic.count > 0 Then
      .Range("D4:AA4").ClearContents
      .Range("D4").Resize(, dic.count).Value = dic.Keys
    Else
      MsgBox "No Data, dic empty"
    End If
   End With
   Columns("D:AA").EntireColumn.AutoFit
End Sub

Still get the error unfortunately. If you are willing to look at a copy of the document with sensitive information removed go to link: Data All Years.xlsm

I am not sure why I keep getting the same error.

 

[DanteAmor]

The problem is not in the macro.
The macro works fine. The problem is in the code that you have in the sheet that is activated when you modify cell A1
I also corrected that code:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Cl As Range
  Dim dic As Object
  Dim f As Range
 
  If Target.CountLarge > 1 Then Exit Sub
  If Target.Address(0, 0) = "A1" Then
 
    Set dic = CreateObject("scripting.dictionary")
    dic.comparemode = 1
    With Sheets("Log")
      Set f = .Range("C:C").Find(Target.Value, , xlValues, xlWhole)
      If f Is Nothing Then
        MsgBox "No Data"
        Target.Select
        Exit Sub
      End If
      For Each Cl In .Range("H2", .Range("H" & Rows.Count).End(xlUp))
        If Cl.Offset(, -5).Value = Target.Value Then dic(Cl.Value) = Empty
      Next Cl
    End With
   
    Me.Range("D4:AA4").ClearContents
    Me.Range("D4").Resize(, dic.Count).Value = dic.Keys
    ActiveWorkbook.Worksheets("Score Card").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Score Card").Sort.SortFields.Add Key:=Range( _
      "D4:T4"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
      xlSortNormal
    With ActiveWorkbook.Worksheets("Score Card").Sort
      .SetRange Range("D4:Z4")
      .Header = xlGuess
      .MatchCase = False
      .Orientation = xlLeftToRight
      .SortMethod = xlPinYin
      .Apply
    End With
    Columns("D:AA").EntireColumn.AutoFit
  End If
End Sub

I return the updated file.

Data All Years dam.xlsm

drive.google.com

-----