For loop to loop though range n cells at a time

Question

Today I am trying to develop a VBA script to loop through specified row 4 cells at a time.

For my project i am trying to determine if a site was surveyed in a particular trip. I am working with a spreadsheet developed in quattro pro containing over 20 years of data. Each survey has 4 cells I am wanting to check if they have a value. There are three possible situations for each site: 1) all four cells contain values, 2) the middle 2 cells contain values or 3) None of the cells have values. For my purposes I am only concerned with situations 1 and 2.

I have developed a code to look for values and if they are found add a row to an array:

Sub Find_Site_Name()

Dim LU_Row_rng As Range                                     'Variable for each survey date row
Dim Survey_Site(0 To 85, 0 To 5) As String                   'overall array for output
Dim SurveyDate As String                                    'Variable declared at begining for survey date in question
Dim Site_ID As String                                       'Variable declared for the site being questioned
Dim N As Integer                                            'Counter used to determine which the next row in the array is for
Dim NN As Integer                                           'Counter used to determine which row we are thinking about

'Add header to array
Survey_Site(0, 0) = "Date"
Survey_Site(0, 1) = "Site"
Survey_Site(0, 2) = "EddyMinto8k"
Survey_Site(0, 3) = "Eddy8kto25k"
Survey_Site(0, 4) = "EddyAbv25k"
Survey_Site(0, 5) = "ChanMinto8k"

Set LU_Row_rng = Range("H4:OY4")

'Set the survey Site ID and Trip Begin Date

'Start Counter so we will it will begin on first survey's row
NN = 4

'Start counter so it will begin on row 2 of array
N = 1

For Each Rng In LU_Row_rng
Rng.Select
    Site_ID = Rng.Offset(-3)

    'Add site id and trip begin date to array

    Survey_Site(1, 1) = Site_ID
    SurveyDate = Range(Cells(NN, 2), Cells(NN, 2)).Value
    Survey_Site(1, 0) = SurveyDate
        'Check to see if eddyminto8k bin has number
        If Rng.Value <> "" Then

        'Eddyminto8k bin has number --> add to array and check next cell
        Survey_Site(N, 2) = "Yes"
        Survey_Site(N, 3) = "Yes"
        Survey_Site(N, 4) = "Yes"
        Survey_Site(N, 5) = "Yes"

         Else
         'Eddymintto8k doesnt have number --> add no number to array and check next cell

            If Rng.Offset(0, 1) <> "" Then
            'There was a survey but did not have bathymetry
            Survey_Site(N, 2) = "NO"
            Survey_Site(N, 3) = "Yes"
            Survey_Site(N, 4) = "Yes"
            Survey_Site(N, 5) = "NO"

            Else
            'There was no survey on this trip --> set counter back one so there wont be a blank row
            N = N - 1

            End If

        'Add one to counter to move to next row of array
        N = N + 1

        End If

'Jump rng forward so next rng will be directly before the next line of interest
Set Rng = Rng.Offset(0, 3)
Rng.Select

Next Rng


End Sub

My problem is that the For Each Rng In LU_Row_rng loop wants to move on a cell by cell basis. I tried to change the current cell the loop is looking at by writing the Set Rng = Rng.Offset(0, 3) line, but that approach does not work when the codes executes the next rng line.

Answer 1

Set LU_Row_rng = Range("H4:OY4")

Set Rng = LU_Row_rng.cells(1).Resize(1,4)
do while not application.intersect(rng,LU_Row_rng) Is Nothing
    '...work with rng
    Set Rng = rng.offset(0,4)
loop