Skybluekid
Well-known Member
- Joined
- Apr 17, 2012
- Messages
- 1,224
- Office Version
- 365
- Platform
- Windows
Hi All,
I am using the below code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Finearray() As String
Dim Lenght As Integer
Dim Rng As Integer
Dim count As Integer
Dim ValStr As String
'Set Array Count to 1
count = 1
'Check to see if Target is Police Authority
If IsError(Application.Search("police", Target.Value)) Then
'Set Val to either "P" or ""
ValStr = ""
Else: ValStr = "P"
End If
'Count number of Val
Lenght = Application.CountIf(Sheet2.Range("F3:F57"), ValStr)
'Redefine Fine Array to Val Lenght
ReDim Finearray(1 To Lenght)
'Loop through range to put Fines into Array
For Rng = 3 To 57
If Sheet2.Cells(Rng, 6).Value = ValStr Then
Finearray(count) = Sheet2.Cells(Rng, 5).Value
count = count + 1
Else: End If
Next Rng
'Put Array in Data Validation
With Target.Offset(, 1).Validation
.Delete
.Add Type:=xlValidateList, Formula1:=Join(Finearray, ",")
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub
It works fine, but when I close the file and reopen it it get an error message saying that it needs to recover the file. It then shows the below dialog box
https://www.dropbox.com/s/0iata3rdify9ygi/Error.jpg?dl=0
After pressing OK, the VBA editor looks like this
https://www.dropbox.com/s/wpx0gsvznhrwtfp/Error 2.jpg?dl=0
It seems to be deleting sheets and creating new ones.
I have put the code into a new workbook, but still have the same result.
Any thoughts would be appreciated.
I am using the below code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Finearray() As String
Dim Lenght As Integer
Dim Rng As Integer
Dim count As Integer
Dim ValStr As String
'Set Array Count to 1
count = 1
'Check to see if Target is Police Authority
If IsError(Application.Search("police", Target.Value)) Then
'Set Val to either "P" or ""
ValStr = ""
Else: ValStr = "P"
End If
'Count number of Val
Lenght = Application.CountIf(Sheet2.Range("F3:F57"), ValStr)
'Redefine Fine Array to Val Lenght
ReDim Finearray(1 To Lenght)
'Loop through range to put Fines into Array
For Rng = 3 To 57
If Sheet2.Cells(Rng, 6).Value = ValStr Then
Finearray(count) = Sheet2.Cells(Rng, 5).Value
count = count + 1
Else: End If
Next Rng
'Put Array in Data Validation
With Target.Offset(, 1).Validation
.Delete
.Add Type:=xlValidateList, Formula1:=Join(Finearray, ",")
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub
It works fine, but when I close the file and reopen it it get an error message saying that it needs to recover the file. It then shows the below dialog box
https://www.dropbox.com/s/0iata3rdify9ygi/Error.jpg?dl=0
After pressing OK, the VBA editor looks like this
https://www.dropbox.com/s/wpx0gsvznhrwtfp/Error 2.jpg?dl=0
It seems to be deleting sheets and creating new ones.
I have put the code into a new workbook, but still have the same result.
Any thoughts would be appreciated.