0

I got this macro that checks all the sheets in the array and color the range M8 which has values on. It works but stops after 38 cell and doesn´t colour any cells.

Can someone please have a look and advice where is somthing wrong.

Thanks in advance

Sub TestColour2()
Dim st As Sheets
Dim x As Integer
Dim wsh As Worksheet

Sheets(Array("T1", "E2", "S3", "M4", "S5", "F5")).Select

    For Each wsh In ActiveWindow.SelectedSheets
        Application.ScreenUpdating = False
       'st.Select
        NumRows = Range("M8", Range("M8").End(xlDown)).Rows.Count
        Range("M8").Select

        For x = 1 To NumRows
            ActiveCell.Interior.ColorIndex = 35
            ActiveCell.Offset(1, 0).Select
        Next x
    Next wsh
Application.ScreenUpdating = True
End Sub
David García Bodego
  • 1,058
  • 3
  • 13
  • 21
Randy
  • 107
  • 1
  • 1
  • 9
  • 1
    First of all it's better to do this with conditional formatting. Second, [avoid using select](https://stackoverflow.com/a/10717999/11936678) as much as possible. Third, your [lastrow statement](https://stackoverflow.com/questions/38882321/better-way-to-find-last-used-row/38882823#38882823) is unreliable. (most likely the issue here) – Plutian Oct 17 '19 at 09:51
  • hi. whats the value of NumRows when it happens ? – Luis Curado Oct 17 '19 at 10:06
  • 36 is the number where it stops at – Randy Oct 17 '19 at 10:54
  • Do you have any blank cells in your M column? – CLR Oct 17 '19 at 11:14
  • After testing this, the issue with your code is that you apply one single coloured range to all sheets at once when you select them, based on the row count of the first sheet. So if the first sheet has 36 rows, all sheets will get coloured up to row 36 max. See my answer below for more reliable methods. – Plutian Oct 17 '19 at 11:22

1 Answers1

0

The below is a more efficient and reliable macro which will get the same result, and will run much quicker:

Updated as per CLR's suggestion, colour the range at once instead of with another loop.

Sub TestColour2()
Dim sheetz As Variant, numrows As Integer, cel As Range, x As Integer
sheetz = Array("T1", "E2", "S3", "M4", "S5", "F5")

For x = 0 To UBound(sheetz)
    With Sheets(sheetz(x))
    numrows = .Range("M" & Rows.Count).End(xlUp).Row

        .Range("M8:M" & numrows).Interior.ColorIndex = 35
    End With
    Next

End Sub

However if only filled cells need to be coloured, my original answer is still valid:

Sub TestColour2()
Dim sheetz As Variant, numrows As Integer, cel As Range, x As Integer
sheetz = Array("T1", "E2", "S3", "M4", "S5", "F5")

For x = 0 To UBound(sheetz)
    With Sheets(sheetz(x))
    numrows = .Range("M" & Rows.Count).End(xlUp).Row

        For Each cel In .Range("M8:M" & numrows)
            If cel.value = "" then cel.Interior.ColorIndex = 35
        Next cel
    End With
    Next

End Sub

Alternatively this can be done with a filter if the range is too large to loop through:

Sub TestColour2()
Dim sheetz As Variant, numrows As Integer, cel As Range, x As Integer
sheetz = Array("T1", "E2", "S3", "M4", "S5", "F5")

For x = 0 To UBound(sheetz)
    With Sheets(sheetz(x))
    numrows = .Range("H" & Rows.Count).End(xlUp).Row
    Debug.Print numrows & Sheets(sheetz(x)).Name


        .Range("H8:H" & numrows).AutoFilter field:="1", Criteria1:="<>"
        .Range("H8:H" & numrows).Rows.SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 35
        .AutoFilterMode = False
        End With
    Next

End Sub
Plutian
  • 2,276
  • 3
  • 14
  • 23
  • 1
    You don't need that `cel` loop to colour each cell. You could just colour the range: `.Range("M8:M" & numrows).Interior.ColorIndex = 35` – CLR Oct 17 '19 at 10:56
  • @CLR good spot, this escaped me entirely since I wanted it to keep it as close to the original code as possible. I'll update my answer with your suggestion. Although the question mentions something about colouring all cells with a value, which isn't done in the original sub. That would require a second loop I think, or a filter. – Plutian Oct 17 '19 at 10:59
  • Thanks Plutian the first code works, and thanks everyone else for taking time to reply. – Randy Oct 17 '19 at 13:06