For Each x In .Range("A1:A" - Any way to select column but shorten the range?

[BPSJACK]

Hi guys,

I have a macro which looks at columns A & B, looks for matching data, and copies adjacent cells to a new column.

However once the macro completes, the sheet now contains 1048576 rows. I only need to apply the macro down to row 10'000. I thought if I changed

For Each x In .Range("A1:A"

to

For Each x In .Range("A1:A10000

then it might solve it but I just get a error 1004 range of object errors.

Any ideas? Below is the sub in question.

Sub Macro1()
Dim x As Range

With Sheet1
    For Each x In .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
        If Not .Range("B1:B" & .Cells(Rows.Count, 2).End(xlUp).Row).Find(x.Value) Is Nothing Then
            .AutoFilterMode = False
            .Range("B1:D" & .Cells(Rows.Count, 1).End(xlUp).Row).AutoFilter Field:=1, Criteria1:=x.Value
            With .AutoFilter.Range
                .Offset(1, 0).Resize(.Rows.Count - 1, 3).Copy
            End With
            .AutoFilterMode = False
            .Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
            Application.CutCopyMode = False
            Application.ScreenUpdating = False
        End If
    Next x
End With

End Sub

[nathansav]

.Range("A1:A" & .range("a1").End(xlDown).Row).cells

Although, where are you getting the error?

[AB33]

Option Explicit

Sub Macro1()
Dim x As Range, Findme As Range

With Sheet1
    For Each x In .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
        Set Findme = .Range("B1:B" & .Cells(Rows.Count, 2).End(xlUp).Row).Find(x.Value)
        If Not Findme Is Nothing Then
            .AutoFilterMode = False
            .Range("B1:D" & .Cells(Rows.Count, 1).End(xlUp).Row).AutoFilter Field:=1, Criteria1:=x.Value
            With .AutoFilter.Range
                .Offset(1, 0).Resize(.Rows.Count - 1, 3).Copy
            End With
            .AutoFilterMode = False
            .Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
            Application.CutCopyMode = False
            Application.ScreenUpdating = False
        End If
    Next x
End With

End Sub

[BPSJACK]

That's brilliant, thank you for your help!