Morning,
I'm having an issue with the below code, i did work once, but suddently gave the error in the title on the For loop starting "For Each family In families()". i cant figure it out, after googling people suggested using option Explicit, which i have but it still doesnt work, ive declared all variables also. Strangely, it does give the result i want it to, but i just get this error every time ??
Option Base 1
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Part As String
Dim LastCell As Range
Dim families()
Dim highfam As String
Dim family As Variant
Dim psppentry, highdc, c As Integer
Dim r2, r1 As Long
'ensure we only run this when the part number entry column is changed
If Target.Column = 1 Then
c = 0
Part = Target.Value
For r1 = 1 To FindLastRow
'ignore if we get #NUM! errors and the like
If IsError(Sheets("FullGPLUSD").Cells(r1, 3)) = False Then
'compare entered part with current GPL entry to see if they match, LC both to eliminate case mismatches
If LCase(Part) = LCase(Sheets("FullGPLUSD").Cells(r1, 3)) Then
r2 = r1
'loop backwards up comlumn A to find the next non empty cell which should be the family
Do Until Sheets("FullGPLUSD").Cells(r2, 1) <> ""
r2 = r2 - 1
Loop
'increment the counter used to redim array and add new family to it
c = c + 1
ReDim Preserve families(1 To c)
families(c) = Sheets("FullGPLUSD").Cells(r2, 1).Value
End If
End If
Next
'end if for checking if we are in the part number entry column
End If
'set highest discount to 0 and highest family to ""
highdc = 0
highfam = ""
For Each family In families()
For psppentry = 1 To 1000
If LCase(Trim(family)) = LCase(Trim(Sheets("PSPPDiscounts").Cells(psppentry, 1))) Then
If Sheets("PSPPDiscounts").Cells(psppentry, 2) > highdc Then
highdc = Sheets("PSPPDiscounts").Cells(psppentry, 2)
highfam = Sheets("PSPPDiscounts").Cells(psppentry, 1)
End If
End If
Next
Next
If highdc = 0 Then highfam = "ERROR: PSPP family not found ?"
Sheets("Main").Cells(Target.Row, 10) = highfam & " - " & highdc
End Sub
Private Function FindLastRow()
Dim LastRow As Long
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Sheets("FullGPLUSD").Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
FindLastRow = LastRow
End If
End Function
Bookmarks