Why doesn't my table update consistently?

[mhorstman]

Hi,

I'm working on a workbook that has an index sheet on it the displays certain data elements based on data on the other worksheets. The issue I am running in to is that my table doesn't always update with all of the data consistently. It is like my For loop is ending early and I can't for the life of me figure out why. What should be happening is that when cell B1 on the index is selected, the string in A2 is collected and then it pulls the data from the sheet that matches the string in A2. Then the location of the name on the index sheet and location of the name on the reference sheet are identified and it pulls the data from the reference sheets and places it in the appropriate column on the index sheet. All of the data pulls correctly, it just doesn't always pull in the first time and I have to change the selection in A2 multiple times to get it all to populate. I'm using Excel 2016. Any help is greatly appreciated.

Private Sub Worksheet_Change(ByVal Target As Range)


'only update sheet based on changes to the Measure Selection cell
Dim KeyCells As Range
Set KeyCells = Range("A2")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

Dim Sh2 As Worksheet
Dim Measure As String
Dim Names As Variant
Dim List As Range
Dim LastC As String
Set Sh2 = ThisWorkbook.Worksheets("Sheet2")
'Identify selected measure
Measure = Cells(2, 1).Value
'Find the matching text for Measure on the reference sheet
Dim listaddress As String
Set List = Sh2.Range("A1:Z1500").Find(Measure, lookat:=xlPart)
listaddress = List.Address
'Find the column number where Measure was found"
Dim listc As Integer
listc = List.column
'Determine how many rows have data in them for that specific measure
Dim r As Range
Dim lastr As Integer
lastr = Sh2.Cells(Sh2.Rows.Count, listc).End(xlUp).Row
'Select the correct number of cells on the summary sheet and copy the names to it
Set r = Sh2.Range(Sh2.Cells(2, listc), Sh2.Cells(lastr, listc))
Names = r.Offset(columnoffset:=1).Value
Range(Cells(4, 1), Cells(lastr, 1)).Value = Names
'add hyperlinks
Dim SubA As String
SubA = ThisWorkbook.Worksheets(Measure).Cells(2, 3).Address
ActiveSheet.Hyperlinks.Delete
lastr = Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Summary Data").Hyperlinks.Add Anchor:=Range(Cells(4, 1), Cells(lastr, 1)), Address:="", SubAddress:=Chr(39) & Measure & Chr(39) & "!" & SubA
ActiveSheet.Cells(1, 2).Select
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Only update the measure table if Cell B1 is selected
If ActiveCell.Address = "$B$1" Then
Dim SumNames As Range
'Set sh1 to the summary data worksheet
Dim sh1 As Worksheet: Set sh1 = ThisWorkbook.Sheets("Summary Data")
'find the last row with data in column A
lastr = sh1.Cells(sh1.Rows.Count, 1).End(xlUp).Row
'Set Measure 1 to the value in Cell A2
Dim measure1 As String: measure1 = sh1.Cells(2, 1).Value
'Set the range sumnames to the names listed in column A
Set SumNames = sh1.Range(sh1.Cells(2, 1), sh1.Cells(lastr, 1))
'Create the CompNames range
Dim CompNames As Range
'Set Sh2 to the worksheet that matches the measure name in A2
Set Sh2 = ThisWorkbook.Worksheets(measure1)
With Sh2
'Find the last row in the list of names on the relevant measure worksheet
lastr = .Cells(.Rows.Count, 2).End(xlUp).Row
'set the compnames range to containt all of the names in the relevant measure worksheet list
Set CompNames = .Range(.Cells(4, 2), .Cells(lastr, 2))
End With
Dim c As Range
Dim d As Range
Dim x As Integer: x = 1
Dim j As Integer: j = 1
Dim k As Integer: k = 1
Dim LastRow As Long
Dim lastrowad As Variant
With sh1
'find the last row in column A on Summary Data sheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'combine the row number in last row with the column letter A
lastrowad = "A" & LastRow
End With
'Clear the data in the output table
sh1.Range(sh1.Cells(4, 2), sh1.Cells(LastRow, 2)) = ""
sh1.Range(sh1.Cells(4, 2), sh1.Cells(LastRow, 3)) = ""
sh1.Range(sh1.Cells(4, 2), sh1.Cells(LastRow, 4)) = ""
sh1.Range(sh1.Cells(4, 2), sh1.Cells(LastRow, 5)) = ""
sh1.Range(sh1.Cells(4, 2), sh1.Cells(LastRow, 6)) = ""
sh1.Range(sh1.Cells(4, 2), sh1.Cells(LastRow, 7)) = ""
'Create a loop that looks at each name (c) in the names list on the relevant measure table (CompNames)
For Each c In CompNames
'set range d to the location that the current name being evaluated (c) is located on
Set d = sh1.Range("A4:" & lastrowad).Find(c.Value, lookat:=xlPart)
Dim col1 As Integer
'set col1 to the row number that d is located on
col1 = d.Row
'make sure that cell A2 has a measure selected
If Not sh1.Cells(2, 1) = "" Then
'Make sure that you haven't run out of names on your relevant measure sheet
If Not c.Value = "" Then
'Compare the name on the relevant measure worksheet (c) to all of the names on the Summary Data worksheet and identify matches
If Application.WorksheetFunction.CountIf(SumNames, c.Value) = 1 Then
'Set range d to the location of the name on the Summary Data sheet
Set d = sh1.Range("A4:" & lastrowad).Find(c.Value, lookat:=xlPart)
'Set col1 to the row number of the name
col1 = d.Row
Dim matchr As Integer
'set matchr to the row number of the name on the relevant measure sheet
matchr = c.Row
'Evaluate if the Validator Outcome column on the relevant measure sheet contains data and populate the mathcing column under validator assessment in the table
If Sh2.Cells(matchr, 21) = "Numerator" Then
sh1.Cells(col1, 2) = "X"
sh1.Cells(col1, 3) = ""
sh1.Cells(col1, 4) = ""
ElseIf Sh2.Cells(matchr, 21) = "Denominator" Then
sh1.Cells(col1, 3) = "X"
sh1.Cells(col1, 2) = ""
sh1.Cells(col1, 4) = ""
ElseIf Sh2.Cells(matchr, 21) = "Excluded" Then
sh1.Cells(col1, 4) = "X"
sh1.Cells(col1, 2) = ""
sh1.Cells(col1, 3) = ""
ElseIf Sh2.Cells(matchr, 21) = "" Then
End If
'Copy the report output column to the table
If Not Sh2.Cells(matchr, 10) = "" Then
sh1.Cells(col1, 5) = Sh2.Cells(matchr, 10)
End If
'Conmpare the Num/Den/Excl to Met/Not Met/Excl and populate the Match column
'Populate the Comments column on the table
If Not Sh2.Cells(matchr, 22) = "" Then
sh1.Cells(col1, 7) = Sh2.Cells(matchr, 22)
End If
End If
End If
End If
'Advance to the next name on the measure sheet list
Next c
End If
End Sub

 

[StephenCrump]

Just a quick guess, based on this bit of code:

Private Sub Worksheet_Change(ByVal Target As Range)    
    '....
    ActiveSheet.Cells(1, 2).Select

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If ActiveCell.Address = "$B$1" Then
        '...

It looks like you're relying on the Worksheet_Change code to trigger the SelectionChange code? But as the name implies, SelectionChange will only trigger if the selection changes. If the ActiveCell is already B1, the code won't trigger.

If this is the problem, then perhaps move the SelectionChange code into a new Sub, and:

Private Sub Worksheet_Change(ByVal Target As Range)    
    '....
    Call SomeSub

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If ActiveCell.Address = "$B$1" Then Call SomeSub

 

[mhorstman]

Thanks Stephen. I don't think that is the issue. The user needs to change their selection in A2 for everything to update and if they do that then it calls the B1 cell selection to make sure the selection changes. I added a msg box after I set the value of d to make sure it was checking all of the names in the list. After I did that, it magically works now. I removed it and it still works. We'll see what happens later Thanks again for the help.

 

[mhorstman]

I found the culprit in case anyone else runs into the issue and happens across this post. I have an auto-filter script on the sheet that the data is pulling from. If the list is filtered then it will only return data up to the filtered name and then jump out of the FOR loop. I added a remove filter (if activesheet.autofiltermode then cells.autofilter) macro on sheet deactivate so that it unfilters the data when you leave the sheet. That fixed the issue.