By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
431,796 Members | 1,205 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 431,796 IT Pros & Developers. It's quick & easy.

Macro to copy data to new sheet based on criteria, error 1004.

P: 26
Hi everyone. I'm trying to write a macro to copy data from one Excel sheet to another in the same workbook when a certain criteria is met.

My data table is an import from an Access DB. After the data has been refreshed to the sheet I would like to pick out all the entries where the value in column I is "High". Once the table has been filtered the values from column A should be pasted to sheet 1("summary").

I will need more that just the information from column A, but as it's a unique ID I can just run Vlookup's off it to keep things simple for now.

I've tried a number of macro's but I'm always hanging up at the same point. Here's the code I'm using so far:

Expand|Select|Wrap|Line Numbers
  1. Application.ScreenUpdating = False
  2. With Worksheets("Data")
  3.     .Range("$A$1:$N$5000").AutoFilter Field:=9, Criteria1:="High"
  4.     .Range("A:A").SpecialCells(xlCellTypeVisible).Copy _
  5.         Worksheets("Summary").Range("B18")
  6.     .Range("G:G").SpecialCells(xlCellTypeVisible).Copy _
  7.         Worksheets("Summary").Range("C18")
  8.     .Range("J:J").SpecialCells(xlCellTypeVisible).Copy _
  9.         Worksheets("Summary").Range("D18")
  10.     .Range("a1").AutoFilter
  11. End With
  12. Application.ScreenUpdating = True
The code is debugs here:
".Range("$A$1:$N$5000").AutoFilter Field:=9,"

I've tried using a different macro, just to filter. Then I can use the parts of the above code to select and paste but what ever I do I get the run time error 1004 "Auto-filter method of range class failed".

I'm using Excel 2010, the data has been automatically formatted as a table when it was brought in by a data import query from Access 2003. Also, as this is only a test version the table only has 6 rows of data.

Thanks very much for any help or insight.
Jun 19 '13 #1

✓ answered by Mihail

Yes. It is a stupid question because your code execute line 2 with no problem.

This code will do your job:
Expand|Select|Wrap|Line Numbers
  1. Sub CopyFilteredValues()
  2. 'Preparatory
  3. Dim CriteriaValue As String, CriteriaColumn As Long, CriteriaFirstRow As Long, CriteriaLastRow As Long
  4.     CriteriaValue = "High" 'Here you can change the criteria _
  5.                             without need to change the entire code
  6.     CriteriaColumn = 9 'The column where to looking for Crit value
  7.     CriteriaFirstRow = 1 'Starting row to search for CriteriaValue
  8.     CriteriaLastRow = 50000 'Last row to search for CriteriaValue
  9.  
  10.  
  11. Dim WSdata As Worksheet, WSsummary As Worksheet
  12.     Set WSdata = Worksheets("Data")
  13.     Set WSsummary = Worksheets("Summary")
  14.  
  15. Dim Rsummary As Long
  16.     Rsummary = 18 - 1 'The row in Summary worksheet where the filtered values will be copied
  17.  
  18. Dim Rdata As Long 'Row in worksheet "Data" - working variable
  19.  
  20. 'Start
  21.     WSsummary.Cells.ClearContents 'Remove al data from "Summary"
  22.     For Rdata = CriteriaFirstRow To CriteriaLastRow
  23.         If WSdata.Cells(Rdata, CriteriaColumn) = CriteriaValue Then
  24.             Rsummary = Rsummary + 1 'Next row in worksheet "Summary"
  25.             WSsummary.Cells(Rsummary, 2) = WSdata.Cells(Rdata, 1) 'Copy column A (from "Data") to Column B (from "Summary")
  26.             WSsummary.Cells(Rsummary, 3) = WSdata.Cells(Rdata, 7) 'Copy column G (from "Data") to Column C (from "Summary")
  27.             WSsummary.Cells(Rsummary, 4) = WSdata.Cells(Rdata, 10) 'Copy column J (from "Data") to Column D (from "Summary")
  28.         End If
  29.     Next Rdata
  30.  
  31.     WSsummary.Activate 'Go to "Summary" worksheet
  32. Exit Sub
  33.  
  34. 'Your code Is here
  35. '    Application.ScreenUpdating = False
  36. '    With Worksheets("Data")
  37. '        .Range("$A$1:$N$5000").AutoFilter Field:=9, Criteria1:="High"
  38. '        .Range("A:A").SpecialCells(xlCellTypeVisible).Copy _
  39. '            Worksheets("Summary").Range("B18")
  40. '        .Range("G:G").SpecialCells(xlCellTypeVisible).Copy _
  41. '            Worksheets("Summary").Range("C18")
  42. '        .Range("J:J").SpecialCells(xlCellTypeVisible).Copy _
  43. '            Worksheets("Summary").Range("D18")
  44. '        .Range("a1").AutoFilter
  45. '    End With
  46. '    Application.ScreenUpdating = True
  47. End Sub

Share this Question
Share on Google+
5 Replies


100+
P: 759
I have tried your code and is OK.

I can think to only one problem:
Have you a worksheet named... Data ?
Sorry if it is a stupid question.
Jun 20 '13 #2

100+
P: 759
Yes. It is a stupid question because your code execute line 2 with no problem.

This code will do your job:
Expand|Select|Wrap|Line Numbers
  1. Sub CopyFilteredValues()
  2. 'Preparatory
  3. Dim CriteriaValue As String, CriteriaColumn As Long, CriteriaFirstRow As Long, CriteriaLastRow As Long
  4.     CriteriaValue = "High" 'Here you can change the criteria _
  5.                             without need to change the entire code
  6.     CriteriaColumn = 9 'The column where to looking for Crit value
  7.     CriteriaFirstRow = 1 'Starting row to search for CriteriaValue
  8.     CriteriaLastRow = 50000 'Last row to search for CriteriaValue
  9.  
  10.  
  11. Dim WSdata As Worksheet, WSsummary As Worksheet
  12.     Set WSdata = Worksheets("Data")
  13.     Set WSsummary = Worksheets("Summary")
  14.  
  15. Dim Rsummary As Long
  16.     Rsummary = 18 - 1 'The row in Summary worksheet where the filtered values will be copied
  17.  
  18. Dim Rdata As Long 'Row in worksheet "Data" - working variable
  19.  
  20. 'Start
  21.     WSsummary.Cells.ClearContents 'Remove al data from "Summary"
  22.     For Rdata = CriteriaFirstRow To CriteriaLastRow
  23.         If WSdata.Cells(Rdata, CriteriaColumn) = CriteriaValue Then
  24.             Rsummary = Rsummary + 1 'Next row in worksheet "Summary"
  25.             WSsummary.Cells(Rsummary, 2) = WSdata.Cells(Rdata, 1) 'Copy column A (from "Data") to Column B (from "Summary")
  26.             WSsummary.Cells(Rsummary, 3) = WSdata.Cells(Rdata, 7) 'Copy column G (from "Data") to Column C (from "Summary")
  27.             WSsummary.Cells(Rsummary, 4) = WSdata.Cells(Rdata, 10) 'Copy column J (from "Data") to Column D (from "Summary")
  28.         End If
  29.     Next Rdata
  30.  
  31.     WSsummary.Activate 'Go to "Summary" worksheet
  32. Exit Sub
  33.  
  34. 'Your code Is here
  35. '    Application.ScreenUpdating = False
  36. '    With Worksheets("Data")
  37. '        .Range("$A$1:$N$5000").AutoFilter Field:=9, Criteria1:="High"
  38. '        .Range("A:A").SpecialCells(xlCellTypeVisible).Copy _
  39. '            Worksheets("Summary").Range("B18")
  40. '        .Range("G:G").SpecialCells(xlCellTypeVisible).Copy _
  41. '            Worksheets("Summary").Range("C18")
  42. '        .Range("J:J").SpecialCells(xlCellTypeVisible).Copy _
  43. '            Worksheets("Summary").Range("D18")
  44. '        .Range("a1").AutoFilter
  45. '    End With
  46. '    Application.ScreenUpdating = True
  47. End Sub
Jun 21 '13 #3

P: 26
Thanks very much for the suggested code Mihail. I'll have a look at it over the weekend and see if it does the business.

Cheers.
Jun 21 '13 #4

P: 26
Thanks very much for the solution Mihail, worked a treat.
Jun 27 '13 #5

jonnycakes
P: 24
Could you not just create a query in access and use docmd.transferspreadsheet, dao, or ado connection?
Jul 20 '13 #6

Post your reply

Sign in to post your reply or Sign up for a free account.