Question

I want to enter multiple values in a single cell in excel sheet based on the certain condition as in if there are multiple sheets in the workbook then if any of the sheet starting with name TC contains color in it then I’ve to enter the information in Read Me Section of the Excel Workbook a another worksheet. The problem with my code is that its not displaying unique sheets which contain coloring…Suppose Sheet “TC_1” and “TC_3” contains color in any of the cell then its displaying the output as “;TC_3;TC_3;TC_3;” although the expected output over here is “TC_1;TC_3”.

Here, is the code:

Sub ErrorInSheet()
    Dim Row
    Dim Names As String
    Names = ""

    For Row = 2 To tsheet.UsedRange.Rows.Count
        For Chkcol = 1 To tsheet.UsedRange.Columns.Count
            If tsheet.Cells(Row, Chkcol).Interior.ColorIndex = 3 Then
                Names = Names & ";" & tsheet.Name
            End If
        Next
    Next Row

    Sheets("Read Me").Cells(13, 5).Value = Names

End Sub

Sub iterateSheets()

    For Each sheet1t In Worksheets

       If InStr(1, sheet1t.Name, "TC") Then
           Set tsheet = sheet1t
           Call ErrorInSheet
       End If
    Next
End Sub

Answer 1

I think this will work for you – I tested it and worked for me.

Sub FindErrors()
    Dim sht As Worksheet, cl As Range, shtNames As String

    shtNames = vbNullString

    For Each sht In Worksheets
       If Left$(sht.Name, 2) = "TC" Then
            For Each cl In sht.UsedRange.Cells
                If cl.Interior.ColorIndex = 3 Then
                    shtNames = IIf(shtNames = vbNullString, sht.Name, shtNames & ";" & sht.Name)
                End If
            Next cl
       End If
    Next sht

    Worksheets("Read Me").Cells(13, 5) = shtNames
End Sub

Notes:

1. I’ve explicitly declared the variables
2. I am assuming all your sheets start with “TC” so I’ve used Left$ but you can use InStr if you like
3. I’ve used the ternary IIF statement to stop you getting a leading ;
4. I’ve put all the code in one Sub but you can split it out if you like