Sheets(MyArr(i)).Range("L2:L20") to a variable range of column L
 

I have a couple attempts commented out trying to make a variable range for column L for each sheet in the array.

The hardcoded range works okay, however.

Thanks.
Howard

Sub Greater_Than_Copy()

Dim MyArr As Variant
Dim c As Range
Dim i As Long
Dim rngA As Range, lrMA As Range
Dim lrCl As Long

lrCl = Sheets("Sheet5").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Sheet5").Range("A1:L" & lrCl)
.ClearContents
End With

MyArr = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")

Application.ScreenUpdating = False

For i = LBound(MyArr) To UBound(MyArr)

With Sheets(MyArr(i))

'Set rngA = Range("L2", Range("L2").End(xlDown))
'Set rngA = Sheets(MyArr(i)).Range("L2", Range("L2").End(xlDown))

Set rngA = Sheets(MyArr(i)).Range("L2:L20")

For Each c In rngA
If c.Value 0 Then
c.Offset(, -11).Resize(1, 12).Copy Sheets("Sheet5").Range("A" & Rows.Count) _
.End(xlUp)(2)
End If
Next 'c

End With
Next 'i

Application.ScreenUpdating = True
End Sub

Sheets(MyArr(i)).Range("L2:L20") to a variable range of column L
 

Hi Howard,

Am Wed, 23 Sep 2015 23:00:27 -0700 (PDT) schrieb L. Howard:

I have a couple attempts commented out trying to make a variable range for column L for each sheet in the array.

try it this way:

Sub Greater_Than_Copy()
Dim MyArr As Variant
Dim c As Range
Dim i As Long
Dim rngA As Range, lrMA As Range
Dim lrCl As Long

With Sheets("Sheet5")
lrCl = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A1:L" & lrCl).ClearContents
End With

MyArr = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")

Application.ScreenUpdating = False

For i = LBound(MyArr) To UBound(MyArr)

With Sheets(MyArr(i))
lrCl = .Cells(Rows.Count, "L").End(xlUp).Row
Set rngA = .Range("L2:L" & lrCl)

For Each c In rngA
If c.Value 0 Then
c.Offset(, -11).Resize(1, 12).Copy Sheets("Sheet5") _
.Range("A" & Rows.Count).End(xlUp)(2)
End If
Next 'c

End With
Next 'i

Application.ScreenUpdating = True
End Sub

But faster without the loop through the cells:

Sub Greater_Than_Copy2()
Dim MyArr As Variant
Dim c As Range
Dim i As Long
Dim rngA As Range, lrMA As Range
Dim lrCl As Long

With Sheets("Sheet5")
lrCl = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A1:L" & lrCl).ClearContents
End With

MyArr = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")

Application.ScreenUpdating = False

For i = LBound(MyArr) To UBound(MyArr)

With Sheets(MyArr(i))
lrCl = .Cells(Rows.Count, "L").End(xlUp).Row
.Range("L:L").AutoFilter Field:=1, Criteria1:="0"
.Range("A2:L" & lrCl).SpecialCells(xlCellTypeVisible).Copy _
Sheets("Sheet5").Range("A" & Rows.Count).End(xlUp)(2)
End With
Next 'i

Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Sheets(MyArr(i)).Range("L2:L20") to a variable range of column L
 

try it this way:

Sub Greater_Than_Copy()
Dim MyArr As Variant
Dim c As Range
Dim i As Long
Dim rngA As Range, lrMA As Range
Dim lrCl As Long

With Sheets("Sheet5")
lrCl = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A1:L" & lrCl).ClearContents
End With

MyArr = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")

Application.ScreenUpdating = False

For i = LBound(MyArr) To UBound(MyArr)

With Sheets(MyArr(i))
lrCl = .Cells(Rows.Count, "L").End(xlUp).Row
Set rngA = .Range("L2:L" & lrCl)

For Each c In rngA
If c.Value 0 Then
c.Offset(, -11).Resize(1, 12).Copy Sheets("Sheet5") _
.Range("A" & Rows.Count).End(xlUp)(2)
End If
Next 'c

End With
Next 'i

Application.ScreenUpdating = True
End Sub

But faster without the loop through the cells:

Sub Greater_Than_Copy2()
Dim MyArr As Variant
Dim c As Range
Dim i As Long
Dim rngA As Range, lrMA As Range
Dim lrCl As Long

With Sheets("Sheet5")
lrCl = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A1:L" & lrCl).ClearContents
End With

MyArr = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")

Application.ScreenUpdating = False

For i = LBound(MyArr) To UBound(MyArr)

With Sheets(MyArr(i))
lrCl = .Cells(Rows.Count, "L").End(xlUp).Row
.Range("L:L").AutoFilter Field:=1, Criteria1:="0"
.Range("A2:L" & lrCl).SpecialCells(xlCellTypeVisible).Copy _
Sheets("Sheet5").Range("A" & Rows.Count).End(xlUp)(2)
End With
Next 'i

Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--

Hi Claus,

Well, rats, that fix looks just like at least one of my attempts, I guess I was just missing a dot or some little thing. Every attempt compiled but always threw an error.

The filter method seems to be gaining popularity, I see more and more of it.

Thanks for corrections.

Howard