Something like this using Union
to glue together your range
- Please note that
For each
loops are quicker than aFor i = 1 to x
approach -
You may well be able to use SpecialCells to determine your new range instantly (e.g. any blanks, any errors, any formulae, etc)
Sub Test() Dim rng1 As Range Dim rng2 As Range Dim c As Range Set rng1 = Range("B1:J1") For Each c In rng1 ' Add cells to rng2 if they exceed 10 If c.Value > 10 Then If Not rng2 Is Nothing Then ' Add the 2nd, 3rd, 4th etc cell to our new range, rng2 ' this is the most common outcome so place it first in the IF test (faster coding) Set rng2 = Union(rng2, c) Else ' the first valid cell becomes rng2 Set rng2 = c End If End If Next End Sub