Filtered list

[Khalil Handal]

Hi, I hope that some one can help!



I want to take a certain range of cells in the file "HCP_2005_upgrade" and
filter so as to select all the cells that are not empty.

Then select all the rows for these cells and copy them to a new workbook
"W_V" in "sheet2". I have the following code.

Three problems:

1- When copying to the new workbook I did not have the same
column width. What should I do in order to have the same column width?

2- What code do I need to add, and where, so as to let the
macro automatically find the last row that is not empty (particularly in
column B). Select only the filtered range.

3- My sheet is protected. The auto filter only works for
unprotected sheets. How can I overcome this problem or go around it. (i.e.
to do filtration for protected sheets).



The code is:

Sub Macro1()

Range("EI16:EI159").Select

Selection.AutoFilter

Selection.AutoFilter Field:=1, Criteria1:="<>"

Rows("1:44").select --à (what code do I need so that the macro do this
automaticaly since it changes often).

Workbooks.Open Filename:="H:\W_V.xls"

Sheet("Sheet2").Select

Selection.PasteSpecial Paste:x1PasteColumnWidths, Operation:=x1None,_

SkipBlanks:=False, Transpose:=False

ActiveSheet.Paste

Range("E7").Select

ActiveWindow.FreezePanes=True

Windows("HCP_2006_Upgrade.xls").Activate

Range("A16").Select

Application.CutCopyMode=False

Selection.AutoFilter

Range("A1").Select

End Sub



Khalil

 

[Dave Peterson]

Since your code depends on what's selected, it's difficult to guess where things
should be pasted.

But this may give you an idea. I didn't test it, but it did compile:

Option Explicit
Sub testme()

Dim RngToFilter As Range
Dim RngToCopy As Range
Dim DestWks As Worksheet
Dim DestCell As Range
Dim LastRow As Long

With ActiveSheet
.Unprotect Password:="hithere"
'turn off any existing filter
.AutoFilterMode = False
Set RngToFilter = .Range("ei16", .Cells(.Rows.Count, "EI").End(xlUp))
RngToFilter.AutoFilter Field:=1, Criteria1:="<>"
If RngToFilter.Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
'no visible rows in filter.
Set RngToCopy = Nothing
Else
With RngToFilter
Set RngToCopy = .Resize(.Rows.Count - 1, 1).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)
End With
End If
.AutoFilterMode = False
.Protect Password:="hithere"
End With

If RngToCopy Is Nothing Then
MsgBox "Nothing filtered--quitting"
Exit Sub
End If

Set DestWks = Nothing
On Error Resume Next
Set DestWks = Workbooks("w_v.xls").Worksheets("sheet2")
On Error GoTo 0
If DestWks Is Nothing Then
Set DestWks = Workbooks.Open("H:\W_V.xls").Worksheets("sheet2")
End If

With DestWks
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
Set DestCell = .Cells(LastRow, "A")
End With

RngToCopy.EntireRow.Copy _
Destination:=DestCell

Application.CutCopyMode = False

End Sub

 

[Khalil Handal]

Hi,
Thanks for what you offer, I will try it. Just want you know it is going to
be pasted in a new empty worksheet.

Khalil

 

[Dave Peterson]

It looked like you posted that it'll be pasted in Sheet2 of an existing
workbook.

 

[Khalil Handal]

Hi,
I tried your code and has a compile error in the with ActiveSheet at x1UP
saying that "variable is not defined"

 

[Dave Peterson]

You should copy and paste from the newsgroup--not retype the responses.

You've introduced a typo. It's xlup (that's an ell, not one).

 

[Khalil Handal]

Hi,
I discovered it later. Thanks any way it worked perfect. I had the first
seven rows from the original sheet copyed and it added the filtered record
after that (using lrow 8). This was exactly as I wanted.

One more thing, is it possible with code to be able to use the same folder
(directory) that the original file is in.
To be more clear:
If I put the original file in "d:\data" folder , the macro will try to open
the file "W_V.xls" from drive "H" as mentioned in the code. Can the code be
adjusted so as it open the file from "D:\data" or any other folder that
might contain the two workbooks togather.

Thank again for you help

Khalil Handal

 

[Dave Peterson]

The file that owns the code is the original file?

If yes, you can change this:
Set DestWks = Workbooks.Open("H:\W_V.xls").Worksheets("sheet2")
to
Set DestWks = Workbooks.Open(thisworkbook.path &
"\W_V.xls").Worksheets("sheet2")

or if the code is in a different workbook, you could use the activesheet's
workbook's folder:
Set DestWks = Workbooks.Open(.parent.path & "\W_V.xls").Worksheets("sheet2")

Hi,
I discovered it later. Thanks any way it worked perfect. I had the first
seven rows from the original sheet copyed and it added the filtered record
after that (using lrow 8). This was exactly as I wanted.

One more thing, is it possible with code to be able to use the same folder
(directory) that the original file is in.
To be more clear:
If I put the original file in "d:\data" folder , the macro will try to open
the file "W_V.xls" from drive "H" as mentioned in the code. Can the code be
adjusted so as it open the file from "D:\data" or any other folder that
might contain the two workbooks togather.

Thank again for you help

Khalil Handal

 

[Dave Peterson]

Watch out for the line break:

Set DestWks = Workbooks.Open(thisworkbook.path _
& "\W_V.xls").Worksheets("sheet2")

 

[Khalil Handal]

Hi,
The code is in the original file.
I am new to this and have little idea about VB code.

Thanks again