Be my hero, help me to fix my macro! Autofilter data, copy and paste into another worksheet

[marcelita03]

Hello geniuses,

I have this in worsheet "RAW":

A B C D E
Manager_ID Employee Data1 Data2 Data3
1 111222 333444 1,000 blue whatever
2 111222 333444 7,000 blue whatever
3 111222 333444 1,000 yellow whatever
4 111222 222555 6,000 blue whatever
5 111222 222555 1,000 gray whatever
6 111222 222555 1,000 blue whatever
7 111222 222555 5,000 blue whatever
8 111222 222555 3,000 blue whatever

I have this value in cell "Q1"

Q
1 111222 ------> I will be changing this input manually later to another manager ID or another employee ID


I need to look at "Q1".. copy all the rows that match "Q1".... WHEN THE CRITERIA IS EITHER IN COLUMN A or B
and paste those rows into another sheet named "DROPVALUES".

So... if I type 111222 in "Q1". I would run my macro and get 8 lines copied into "DROPVALUES"
Or when I type 333444 I would run my macro and get 8 lines copied into "DROPVALUES"
I want either the manager or the employee to look at the records...but the employee won't be able to see other employees data.

I am accomplishing this with this macro:

[Dim wkbCurrent As Workbook
Dim wksCopySet As Worksheet
Dim wksDataSet As Worksheet
Dim strNameMgr As String
Dim strNameEmp As String
Dim strUserName As String
Dim intDataRow As Long
Dim intCopySet As Long

Application.ScreenUpdating = False

Set wkbCurrent = ActiveWorkbook
Set wksDataSet = wkbCurrent.Sheets("RAW")
Set wksCopySet = wkbCurrent.Sheets("DropValues")

strUserName = wksDataSet.Cells(1, 17)
intDataRow = 2
intCopySet = 2
strNameMgr = wksDataSet.Cells(intDataRow, 2)
strNameEmp = wksDataSet.Cells(intDataRow, 3)
Sheets("RAW").Visible = True
Sheets("DropValues").Visible = True

Do Until strNameMgr = ""
strNameMgr = wksDataSet.Cells(intDataRow, 2)
strNameEmp = wksDataSet.Cells(intDataRow, 3)
If strNameMgr = strUserName Or strNameEmp = strUserName Then
wksDataSet.Select
Rows(intDataRow).Select
Selection.Copy
wksCopySet.Select
Rows(intCopySet).Select
Selection.PasteSpecial Paste:=xlPasteValues
intCopySet = intCopySet + 1
End If

intDataRow = intDataRow + 1

Loop
Sheets("Output").Visible = True

Sheets("DropValues").Visible = False
Sheets("RAW").Visible = False

Application.ScreenUpdating = True

End Sub]



But unfortunately the macro takes FOREVER!! as it has to go through half million rows and copy and paste one by one.

I want to do this using AUTOFILTER instead, but I have been trying for a couple of days and I can't seem to figure out how.

Please help...please.

 

[marcelita03]

Code that I am using (but I want to replace with something with Autofilter):

code
Dim wkbCurrent As Workbook
Dim wksCopySet As Worksheet
Dim wksDataSet As Worksheet
Dim strNameMgr As String
Dim strNameEmp As String
Dim strUserName As String
Dim intDataRow As Long
Dim intCopySet As Long

Application.ScreenUpdating = False

Set wkbCurrent = ActiveWorkbook
Set wksDataSet = wkbCurrent.Sheets("RAW")
Set wksCopySet = wkbCurrent.Sheets("DropValues")

strUserName = wksDataSet.Cells(1, 17)
intDataRow = 2
intCopySet = 2
strNameMgr = wksDataSet.Cells(intDataRow, 2)
strNameEmp = wksDataSet.Cells(intDataRow, 3)
Sheets("RAW").Visible = True
Sheets("DropValues").Visible = True

Do Until strNameMgr = ""
strNameMgr = wksDataSet.Cells(intDataRow, 2)
strNameEmp = wksDataSet.Cells(intDataRow, 3)
If strNameMgr = strUserName Or strNameEmp = strUserName Then
wksDataSet.Select
Rows(intDataRow).Select
Selection.Copy
wksCopySet.Select
Rows(intCopySet).Select
Selection.PasteSpecial Paste:=xlPasteValues
intCopySet = intCopySet + 1
End If

intDataRow = intDataRow + 1

Loop
Sheets("Output").Visible = True

Sheets("DropValues").Visible = False
Sheets("RAW").Visible = False

Application.ScreenUpdating = True

End Sub

/code