在Excel中先行再行

Question

I have a range of data in excel which is uniform, Column A has a description, Column B has a unique ID and column C is blank. Then the next 3 columns have the same set of data. I am trying to get my vba loop to go down the two sets of data and compare the unique ID's, if there are differences it copies it to the range of data to a new sheet.

The issue is it is not just 6 columns of data its about a couple of hundred, so once the final row has been reached after checking the first range of data, the loop needs to move over 6 columns to begin the process again.

I am having some difficulty getting the loop to move across 6 columns once the finalrow has been reached

Sub finddata()

Dim s As Worksheet
Dim uniqueId As String
Dim finalrow As Long
Dim i As Long
Dim c As Long
Dim rngSearch As Range
Dim rngFound As Range
Dim finalcolumn As Long
Dim offset As Integer

Application.ScreenUpdating = True

uniqueId = Sheets("Data").Range("B2").Value
finalrow = Sheets("Data").Range("G100000").End(xlUp).Row
finalcolumn = Sheets("Data").Range("XFD1").End(xlToLeft).Column
offset = 3

Set s = Sheets("Data")
Set rngSearch = s.Range(s.Cells(2, 5), s.Cells(finalrow, 5))

Sheets("DataValidation").Range("A1:C100000").ClearContents

If i = finalrow GoTo 'guessing this is how to being to loop to move over columns
    For i = 2 To finalrow
        uniqueId = s.Cells(i, 2).Value
        Set rngFound = rngSearch.Find(What:=uniqueId, LookIn:=xlValues, LookAt:=xlWhole)
        If rngFound Is Nothing Then
            s.Range(Cells(i, 1), Cells(i, 6)).Copy
            Sheets("DataValidation").Range("A1048575").End(xlUp).offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
            End If
    Next i

MsgBox "Done"
End Sub

Answer 1

Try that one

For j = 1 to finalcolumn step 6
    Set rngSearch = s.Range(s.Cells(2, j - 1 + 5), s.Cells(finalrow, j - 1 + 5))
    For i = 2 To finalrow
        uniqueId = s.Cells(i, 2 + j - 1).Value
        Set rngFound = rngSearch.Find(What:=uniqueId, LookIn:=xlValues, LookAt:=xlWhole)
            If rngFound Is Nothing Then
                s.Range(Cells(i, 1 + j - 1), Cells(i, 6 + j - 1)).Copy
                Sheets("DataValidation").Range("A1048575").End(xlUp). _
                               offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
            End If
    Next i
Next j

Hope it helps

Answer 2

Here is a short example of how you can iterate on uniform ranges of 3 columns, and moving right by offset of 6. You said your ranges are uniform so I hard-coded the initial value of rngSet.

In the For Each I'm printing the address of the cells but you can do your checks there. The While loop will end when it reaches an empty cell.

Dim rngSet As Range, rngRow As Range

Set rngSet = Range("A1:B6")

While Not IsEmpty(rngSet.Cells(1, 1).Value)

    For Each rngRow In rngSet.Rows
        Debug.Print rngRow.Cells(1, 1).Address
    Next rngRow

    Set rngSet = rngSet.Offset(0, 6)
Wend