Critique my filter/copy/visiblecells code...
 

This works pretty good, but seems to me to not be the "proper" use of .VisibleCells.

Where the code looks at all sheets in the array, column E, if the value in E has an "X" in the adjacent column D, then copy E value to sheet 1 column AG next open cell.

Is fairly fast, but only using 20 or so rows on each sheet.

Thanks,
Howard

Sub Many_To_One_Copy_1()

Dim i As Long
Dim MyArr As Variant
Dim lr As Long
Dim rngE As Range, c As Range

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

Application.ScreenUpdating = False

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

With Sheets(MyArr(i))

.AutoFilterMode = False

lr = .Cells(.Rows.Count, 5).End(xlUp).Row
Set rngE = .Range("$D$1:$E$" & lr)

rngE.AutoFilter Field:=1, Criteria1:="=X"
.Range("$E$2:$E$" & lr).SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet1").Range("AG" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues

rngE.AutoFilter

End With
Next 'i

Application.ScreenUpdating = True
End Sub

Critique my filter/copy/visiblecells code...
 

Just another way, but uses less code...

Sub Many_To_One_Copy_2()
Dim rng As Range, lLastRow&, v
Const sShtsList$ = "Sheet2,Sheet3,Sheet4,Sheet5"

Application.ScreenUpdating = False
For Each v In Split(sShtsList, ",")
With Sheets(v)
.AutoFilterMode = False
lLastRow = .Cells(.Rows.Count, 5).End(xlUp).Row
Set rng = .Range("$D$1:$E$" & lLastRow)

rng.AutoFilter Field:=1, Criteria1:="=X"
.Range("$E$2:$E$" &
lLastRow).SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet1").Range("AG" &
Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
rng.AutoFilter
End With 'Sheets(v)
Next 'v
Application.ScreenUpdating = True
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

---
This email has been checked for viruses by Avast antivirus software.
https://www.avast.com/antivirus

Critique my filter/copy/visiblecells code...
 

Hi Howard,

Am Tue, 7 Jun 2016 16:31:24 -0700 (PDT) schrieb L. Howard:

This works pretty good, but seems to me to not be the "proper" use of .VisibleCells.

do you have issues?
For me it works fine and with the cisible cells you are on the save
side.
But Copy method only copies visible cells and so SpecialCells are not
needed:
Sub Many_To_One_Copy_1()

Dim i As Long
Dim MyArr As Variant
Dim lr As Long
Dim rngE As Range, c As Range

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

Application.ScreenUpdating = False

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

With Sheets(MyArr(i))
.AutoFilterMode = False

lr = .Cells(.Rows.Count, 5).End(xlUp).Row
Set rngE = .Range("$D$1:$E$" & lr)

rngE.AutoFilter Field:=1, Criteria1:="=X"
.Range("$E$2:$E$" & lr).Copy
Sheets("Sheet1").Range("AG" & Rows.Count).End(xlUp)(2).PasteSpecial
Paste:=xlPasteValues

.AutoFilterMode = False

End With
Next 'i

Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Windows10
Office 2016

Critique my filter/copy/visiblecells code...
 

But Copy method only copies visible cells and so SpecialCells are not
needed:

Yes, indeed. It also just pastes values resulting from formulas. In
that case, if no formatting, PasteSpecial won't be necessary either.
(Just specify destination!)

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

---
This email has been checked for viruses by Avast antivirus software.
https://www.avast.com/antivirus

Critique my filter/copy/visiblecells code...
 

On Wednesday, June 8, 2016 at 12:37:42 AM UTC-7, GS wrote:
Just another way, but uses less code...


Hi Garry,

That's a pretty nifty way to get it done also. I like that.

Thanks.

Howard

Critique my filter/copy/visiblecells code...
 

do you have issues?
For me it works fine and with the cisible cells you are on the save
side.
But Copy method only copies visible cells and so SpecialCells are not
needed:
Sub Many_To_One_Copy_1()

Dim i As Long
Dim MyArr As Variant
Dim lr As Long
Dim rngE As Range, c As Range

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

Application.ScreenUpdating = False

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

With Sheets(MyArr(i))
.AutoFilterMode = False

lr = .Cells(.Rows.Count, 5).End(xlUp).Row
Set rngE = .Range("$D$1:$E$" & lr)

rngE.AutoFilter Field:=1, Criteria1:="=X"
.Range("$E$2:$E$" & lr).Copy
Sheets("Sheet1").Range("AG" & Rows.Count).End(xlUp)(2).PasteSpecial
Paste:=xlPasteValues

.AutoFilterMode = False

End With
Next 'i

Application.ScreenUpdating = True
End Sub


Regards
Claus B.


Hi Claus,

No issues to speak of, was wondering if I was using VisibleCells correctly, or even if I should omit VisibleCells since I only wanted the E column.

One method I used VisiblCells and it copied Headers, column D and column E of filters data.

Thanks.

Howard