List/display sheet name on main sheet if value in cell is less than 7

[tracid1987]

Hello

I have a workbook in Excel 2007 with many sheets of different companies (printscreen is an example only), which contain the same type of cells and columns, just the dates are different. If you look at the printscreens each sheet has its name (company name) and in every sheet there are deadline dates in the future (in two columns B and H). The columns next to the deadline columns (C and I) automatically calculate how many days are left till deadline ( =B2-TODAY() ; =H2-TODAY() )

I dont want to check every sheet one by one to see if deadline is coming in less than 7 days, i want to list on the first summary sheet the names of sheets where in the column "Number of days remaining" (C and I columns) is value less than 7.
Optional: if there isnt any sheet to display then the list/cells on the summary sheet are empty, but if there is a sheet name displayed then it should be for example with font size 24 and cell background red to highlight it. But this is really only optional, if its harder to achieve or explain then just forget about it.

(Or possible alternative is that colour is automatically changed to red in a sheet if due date is less than 7 days and the summary sheet has to only determine which sheet contains any cell with red colour - i dont know if its easier to specify only red colour or specify a few columns one by one. both solutions are welcome)

I would really appreciate your help.
Thank you

 

[ZMyrrh]

Public Sub Summary()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim h As Integer
Dim sum As Worksheet: Set sum = Worksheets("Summary")

sum.Activate


'Remove the ' below if you want to delete the summary cells in the range "b2:b10"
'Range(Cells(2, 2), Cells(WorksheetFunction.CountA(Range("b1:b10")) + 1, 2)).ClearContents


For i = 2 To Sheets.Count
    
    Sheets(i).Activate
    For k = 2 To WorksheetFunction.CountA(Range("c2:c100")) + 1
    
        
        
        If Cells(k, 3).Value < 7 Then
        
            If WorksheetFunction.CountIf(sum.Range("b2:b100"), Sheets(i).Name) < 1 Then
            
                sum.Cells(WorksheetFunction.CountA(sum.Range("b1:b100")) + 1, 2).Value = Sheets(i).Name
                
            End If
        
            Cells(k, 3).Interior.Color = vbRed
            
        End If
        
    Next k
    
    For h = 2 To WorksheetFunction.CountA(Range("i2:i100")) + 1
        
        If Cells(h, 9).Value < 7 Then
            
            
            If WorksheetFunction.CountIf(sum.Range("b2:b100"), Sheets(i).Name) < 1 Then
            
                sum.Cells(WorksheetFunction.CountA(sum.Range("b1:b100")) + 1, 2).Value = Sheets(i).Name
                
            End If
        
            Cells(h, 9).Interior.Color = vbRed
            
        
        End If
    
    Next h

Next i

sum.Activate

End Sub

 

[Joe4]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: List/display sheet name on main sheet if value in cell is less than 7
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[tracid1987]

Public Sub Summary()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim h As Integer
Dim sum As Worksheet: Set sum = Worksheets("Summary")

sum.Activate


'Remove the ' below if you want to delete the summary cells in the range "b2:b10"
'Range(Cells(2, 2), Cells(WorksheetFunction.CountA(Range("b1:b10")) + 1, 2)).ClearContents


For i = 2 To Sheets.Count
   
    Sheets(i).Activate
    For k = 2 To WorksheetFunction.CountA(Range("c2:c100")) + 1
   
       
       
        If Cells(k, 3).Value < 7 Then
       
            If WorksheetFunction.CountIf(sum.Range("b2:b100"), Sheets(i).Name) < 1 Then
           
                sum.Cells(WorksheetFunction.CountA(sum.Range("b1:b100")) + 1, 2).Value = Sheets(i).Name
               
            End If
       
            Cells(k, 3).Interior.Color = vbRed
           
        End If
       
    Next k
   
    For h = 2 To WorksheetFunction.CountA(Range("i2:i100")) + 1
       
        If Cells(h, 9).Value < 7 Then
           
           
            If WorksheetFunction.CountIf(sum.Range("b2:b100"), Sheets(i).Name) < 1 Then
           
                sum.Cells(WorksheetFunction.CountA(sum.Range("b1:b100")) + 1, 2).Value = Sheets(i).Name
               
            End If
       
            Cells(h, 9).Interior.Color = vbRed
           
       
        End If
   
    Next h

Next i

sum.Activate

End Sub

Thank you for your kind and fast response. I have to apologize for cross posting, it wont happen again, and thank you for informing me about it.
I have to once more apologize for making trouble and extra work, i am new on forums and i am learning now how should i post and what. I thought i post a simpler example of my problem so its easier to understand for you and offer a solution then i can extend it and solve my root work. But i have just realized that i was going the wrong way. Because since its a VB code i did not manage to understand the code flow and extend it to my needs. So i apologize once more and now i explain my root work which i need to solve. so i need the solution for the work below.

The logic is the same, there are just a few more columns that need to be checked if value is less than 7. And i would appreciate a short explanation which lines or numbers should i change/extend if by time more and more sheets will be added (so on the printscreen you see the initial number of sheets but as time passes i will add more and more sheets with company names. So if the VB code does not adapt to it automatically, i have to know which lines should i change.


so logic should check in every sheet columns D3 to D200, I3 to I200, N3 to N200, S3 to S200 if number in cells is less than 7.
Where it finds value less than 7, it should list the name of corresponding sheet on the "Summary" sheet into column B2 and below.
If there is no sheet name displayed on the Summary, or the dates are updated so the due date is updated as well (and values will be greater than 7), the Summary list should be updated as well accordingly. So clearing the cells should be taken into account if criteria is not met. I have to highlight that it is possible that sometimes the list will be shorter (less sheet names listed), sometimes longer (more sheet names listed), sometimes empty (no sheet names displayed), its all according to the numbers if it founds value less than 7.
Optional: change background color of cell in B2 column of displayed sheet name. (again, if the cell is updated and sheet name removed then the background should be white again)

I really thank you so much for helping me

 

[tracid1987]

Public Sub Summary()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim h As Integer
Dim sum As Worksheet: Set sum = Worksheets("Summary")

sum.Activate


'Remove the ' below if you want to delete the summary cells in the range "b2:b10"
'Range(Cells(2, 2), Cells(WorksheetFunction.CountA(Range("b1:b10")) + 1, 2)).ClearContents


For i = 2 To Sheets.Count
   
    Sheets(i).Activate
    For k = 2 To WorksheetFunction.CountA(Range("c2:c100")) + 1
   
       
       
        If Cells(k, 3).Value < 7 Then
       
            If WorksheetFunction.CountIf(sum.Range("b2:b100"), Sheets(i).Name) < 1 Then
           
                sum.Cells(WorksheetFunction.CountA(sum.Range("b1:b100")) + 1, 2).Value = Sheets(i).Name
               
            End If
       
            Cells(k, 3).Interior.Color = vbRed
           
        End If
       
    Next k
   
    For h = 2 To WorksheetFunction.CountA(Range("i2:i100")) + 1
       
        If Cells(h, 9).Value < 7 Then
           
           
            If WorksheetFunction.CountIf(sum.Range("b2:b100"), Sheets(i).Name) < 1 Then
           
                sum.Cells(WorksheetFunction.CountA(sum.Range("b1:b100")) + 1, 2).Value = Sheets(i).Name
               
            End If
       
            Cells(h, 9).Interior.Color = vbRed
           
       
        End If
   
    Next h

Next i

sum.Activate

End Sub

I just checked your code on my first example. It is working but there was a misunderstanding. You made red all the corresponding cells in all the sheets where value is less than 7. I dont want to touch other sheets by the macro only the "Summary" sheet. (because in my second and main example i handle cell coloring in other sheets on my own) So when the code lists the names of sheets on the Summary sheet, the list should have red background colour (i know theres not much meaning to it because what is on the list is definitely less than 7 so theres not much meaning in highlighting it too but i just wanted to make it more apparent by highlighting besides listing them).
I hope i was clear, its a bit hard to explain in english.

Thank you

 

[tracid1987]

So the red marking logic should be corrected + please create the code following the second workbook example because the second is what i need. Please forget about the first/initial example at the top of thread (sorry for causing extra work, i could not figure out the VB code to adapt to my needs. I will keep in mind this in future). thank you

 

[tracid1987]

Public Sub Summary()

Hello
Today at night i woke up and when i opened my eyes i had figured out the code. I am not a coder so it took a while but i think i have managed to adopt it to my work now. I still dont understand it i just managed to adopt the logic and it accidentally works. The only thing i did not know how to do is to make cells on the summary sheet red. i will post my edited code later and ask how to achieve red cells on summary sheet after i get answer for the following questions:
you wrote "Public Sub Summary()" and i had replaced it with "Private Sub Workbook_Open()" to run the macro at opening the document. is it good? does it matter if its public or private?

'Range(Cells(2, 2), Cells(WorksheetFunction.CountA(Range("b1:b10")) + 1, 2)).ClearContents

why b1:b10? why the b1 if that cell does not indicate the top cell of list but its an informative message which should not be cleared? but if i execute the b1 still does not get cleared but below cells got cleared so it works as expected, so i dont understand why it doesnt look like this: b2:b10? (by the way can i rewrite b10 to b100 for example to clear more cells if i will have more companies?

If WorksheetFunction.CountIf(sum.Range("b2:b100"), Sheets(i).Name) < 1 Then sum.Cells(WorksheetFunction.CountA(sum.Range("b1:b100")) + 1, 2).Value = Sheets(i).Name

on the first line you wrote b2:b100 then after that b1:b100 - that is again confusing me. why are you using first b1 then b2?

I would appreciate your answers. And thank you a lot for the code, its really a huge help for me