0

I have a table put together as a database. I am trying to write a macro to search a System Size column in my table to find "2500" then search a Standard column to find "Standard" then search a Category column to find "FL" I then want to copy the value from a Select Item column pertaining to the row these values were found in to another sheet. For example, the macro will search Column E (System Size) for all "2500", then it will search Column F (Standard) for all "Standard", then it will search Column G (Category) for all "FL". I then want it to copy the values from Column C (Select Item) for every line that meets these requirements and paste it to another sheet. Following is the code I have so far but I can only get it to search one cell and not the entire column. There is probably a better way to go about it but this is the only way I have found that works.

Sub ImDoingMyBest()
'
' ImDoingMyBest Macro
'

'
    If Sheets("Database").Range("E2").Value Like "*2500*" Then
    Sheets("Database").Range("C2").Copy
    Sheets("Quote Sheet").Select
    Range("B26").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
End If
End Sub
Community
  • 1
  • 1
Jamie Walker
  • 213
  • 5
  • 10
  • 24
  • An image may be very helpful here to describe your data, and what you're looking to achieve. Also it's not clear what you're asking, as you say that your code currently works? Lastly, consider looking at pivot tables for this, they would be very easy for something like this. – Tim Feb 15 '13 at 17:04
  • Use .`Find` to seach for the values. Here is an example http://www.siddharthrout.com/2011/07/14/find-and-findnext-in-excel-vba/ Alternatively you can use Autofilter to filter your data and copy it. See this thread http://stackoverflow.com/questions/11631363/how-to-copy-a-line-in-excel-using-a-specific-word-and-pasting-to-another-excel-s – Siddharth Rout Feb 15 '13 at 17:18
  • I have tried to add an image but it says I have to have 10 reputation or something. And I was saying my code currently works for the one cell. I need it to search the entire column, not just one cell but that is the only way I can get it to work. – Jamie Walker Feb 15 '13 at 18:22
  • @Siddharth, re using .Find, I was trying out applying to this question your code in section 4 (VLOOKUP) of your linked page. It errors out with an "Object variable ... not set" msg at the .Find line. ??. – chuff Feb 16 '13 at 03:02
  • @chuff: It is very difficult to know without seeing your code :) BTW, using the `Autofilter` is a much better option for the above case :) – Siddharth Rout Feb 16 '13 at 05:28
  • @Siddarth, I was unclear - it was your code that was erroring out for me. Thanks for the advice on Autofilter. – chuff Feb 16 '13 at 07:29

2 Answers2

0

The way to search the whole column is to use a for-loop; for instance:

For i  = 1 To 10000

    If Sheets("Database").Range("E" & i).Value Like "*2500*" Then

        Sheets("Database").Range("C" & i).Copy
        ...
        ...

    End If

Next i

Alternatively (and my preference) use the Cells(row, column) format rather than Range - this avoids having to concatenate the Range reference. This would take

Range("E" & i)

and change to

Cells(i, 5)

which is neater code (IMO).

DomW
  • 26
  • 4
0

Following up on Siddarth Rout's comments, the following code uses Autofilter to isolate the rows in the "Database" sheet that meet your criteria, and then copies the corresponding values in column C to a range beginning in cell B26 of the sheet named "Quote Sheet".

Sub FilterAndCopy()

    Dim dataWs As Worksheet
    Dim copyWs As Worksheet
    Dim totRows As Long
    Dim lastRow As Long

    Set dataWs = Worksheets("Database")
    Set copyWs = Worksheets("Quote Sheet")

    With dataWs
        .AutoFilterMode = False
        With .Range("C:G")
             .AutoFilter Field:=3, Criteria1:="2500"
             .AutoFilter Field:=4, Criteria1:="Standard"
             .AutoFilter Field:=5, Criteria1:="FL"
        End With
    End With

    totRows = dataWs.Range("C:C").Rows.count
    lastRow = dataWs.Range("C" & totRows).End(xlUp).Row
    dataWs.Range("C2:C" & lastRow).Copy
    copyWs.Range("B26").PasteSpecial Paste:=xlPasteValues
    dataWs.AutoFilterMode = False

End Sub
chuff
  • 5,846
  • 1
  • 21
  • 26