make specific selection based on column value

**shevy** · 05-25-2010, 01:58 PM

How can I use VB to make a selection of rows based on a specific column having a certain value.
For eg. I want to select all rows that have a value of "2" in column C. I then want to select 3 specific columns from those rows that have a 2 in column C and copy them to a different sheet.

a b c d e
1 1 1 1 1
1 1 2 1 1
2 1 2 1 1
1 2 1 1 1
1 2 2 2 2

From the above I want to select the a, b and c cells in the rows where c=2; resulting in this:
a b c
1 1 2
2 1 2
1 2 2

I would then do the same where column c = 1, this time selecting cells from columns a c and e, resulting in:

a c e
1 1 1
1 1 1

**Leith Ross** · 05-25-2010, 04:59 PM

Hello shevy,

Welcome to the Forum!

Here is a VBA macro to filter and copy the data as you requested. You will need to make some changes to the variable values to match your workbook. Currently the macro looks at all the used cells on "Sheet1" and copies matching values to "Sheet2" starting with cell "A1". Column "C" is used as the match column and the match value is 2.

Sub Macro1A()

 Dim Cell As Range
 Dim Col As Variant
 Dim DstRng As Range
 Dim KeepColumns As Variant
 Dim MatchColumn As Variant
 Dim MatchValue As Variant
 Dim N As Long
 Dim RngEnd As Range
 Dim SrcRng As Range
 
   Set SrcRng = Worksheets("Sheet1").UsedRange
   Set DstRng = Worksheets("Sheet2").Range("A1")
   
   KeepColumns = Array("A", "B", "C")
   MatchColumn = "C"
   MatchValue = 2
   
    'Find next empty row in destination
     Set RngEnd = DstRng.Parent.Cells(Rows.Count, DstRng.Column).End(xlUp)
     Set DstRng = IIf(RngEnd.Row < DstRng.Row, DstRng, RngEnd.Offset(1, 0))
   
     For Each Cell In SrcRng.Columns(MatchColumn).Cells
       If Cell.Value = MatchValue Then
          R = Cell.Row
          C = 0
          For Each Col In KeepColumns
            DstRng.Offset(N, C) = SrcRng.Cells(R, Col)
            C = C + 1
          Next Col
          N = N + 1
       End If
     Next Cell
     
End Sub

EDIT: Added example workbook 27-May-2010