Skip to main content
added 50 characters in body; edited title
Source Link
pnuts
  • 59.8k
  • 11
  • 93
  • 141

VBA How to select rows that meetsmeet multiple criteria from a column in excel?

I am trying to copy and paste the rows based on column A that appearsappear in column B to a new sheet (e.g., copy and paste all rows that contain 1,2, 2 and 7 in column A to a new sheet). I know a less smart way using macro. I believe using a nested loop will make life easier (when column B is a long list), however, mine did not work. Please see my LessSmartWay code and FailedSmartWay code below. Any help will be greatly appreciated.

A B C D 1 1 a 1/1/2015 1 2 b 1/2/2015 1 7 c 1/3/2015 2 - a 1/4/2015 3 - b 1/5/2015 3 - c 1/6/2015 3 - a 1/7/2015 3 - b 1/8/2015 4 - c 1/9/2015 4 - a 1/10/2015 5 - b 1/11/2015 5 - c 1/12/2015 6 - a 1/13/2015 6 - b 1/14/2015 6 - c 1/15/2015 7 - a 1/16/2015 7 - b 1/17/2015 7 - c 1/18/2015 

A B C D
1 1 a 1/1/2015
1 2 b 1/2/2015
1 7 c 1/3/2015
2 - a 1/4/2015
3 - b 1/5/2015
3 - c 1/6/2015
3 - a 1/7/2015
3 - b 1/8/2015
4 - c 1/9/2015
4 - a 1/10/2015
5 - b 1/11/2015
5 - c 1/12/2015
6 - a 1/13/2015
6 - b 1/14/2015
6 - c 1/15/2015
7 - a 1/16/2015
7 - b 1/17/2015
7 - c 1/18/2015.

Sub LessSmartWay() Set t = Sheets("test") Set r = Sheets("select") Dim d As Integer Dim j As Integer d = 1 j = 2 Do Until IsEmpty(t.Range("A" & j)) If t.Range("A" & j) = t.Range("B2") Or t.Range("A" & j) = t.Range("B3") Or t.Range("A" & j) = t.Range("B4") Then d = d + 1 r.Rows(d).Value = t.Rows(j).Value End If j = j + 1 Loop End Sub    

.

Sub FailedSmartWay() Set t = Sheets("test") Set r = Sheets("select") Dim d As Integer Dim j As Integer Dim i As Integer d = 1 j = 2 i = 2 Do Until IsEmpty(t.Range("B" & i)) Do Until IsEmpty(t.Range("A" & j)) If t.Range("A" & j) = t.Range("B" & i) Then d = d + 1 r.Rows(d).Value = t.Rows(j).Value End If j = j + 1 Loop i = i + 1 Loop End Sub 

VBA How to select rows that meets multiple criteria from a column in excel?

I am trying to copy and paste the rows based on column A that appears in column B to a new sheet (e.g., copy and paste all rows that contain 1,2, and 7 in column A to a new sheet). I know a less smart way using macro. I believe using a nested loop will make life easier (when column B is a long list), however, mine did not work. Please see my LessSmartWay code and FailedSmartWay code below. Any help will be greatly appreciated.

A B C D
1 1 a 1/1/2015
1 2 b 1/2/2015
1 7 c 1/3/2015
2 - a 1/4/2015
3 - b 1/5/2015
3 - c 1/6/2015
3 - a 1/7/2015
3 - b 1/8/2015
4 - c 1/9/2015
4 - a 1/10/2015
5 - b 1/11/2015
5 - c 1/12/2015
6 - a 1/13/2015
6 - b 1/14/2015
6 - c 1/15/2015
7 - a 1/16/2015
7 - b 1/17/2015
7 - c 1/18/2015

Sub LessSmartWay() Set t = Sheets("test") Set r = Sheets("select") Dim d As Integer Dim j As Integer d = 1 j = 2 Do Until IsEmpty(t.Range("A" & j)) If t.Range("A" & j) = t.Range("B2") Or t.Range("A" & j) = t.Range("B3") Or t.Range("A" & j) = t.Range("B4") Then d = d + 1 r.Rows(d).Value = t.Rows(j).Value End If j = j + 1 Loop End Sub   Sub FailedSmartWay() Set t = Sheets("test") Set r = Sheets("select") Dim d As Integer Dim j As Integer Dim i As Integer d = 1 j = 2 i = 2 Do Until IsEmpty(t.Range("B" & i)) Do Until IsEmpty(t.Range("A" & j)) If t.Range("A" & j) = t.Range("B" & i) Then d = d + 1 r.Rows(d).Value = t.Rows(j).Value End If j = j + 1 Loop i = i + 1 Loop End Sub 

How to select rows that meet multiple criteria from a column?

I am trying to copy and paste the rows based on column A that appear in column B to a new sheet (e.g. copy and paste all rows that contain 1, 2 and 7 in column A to a new sheet). I know a less smart way using macro. I believe using a nested loop will make life easier (when column B is a long list), however, mine did not work. Please see my LessSmartWay code and FailedSmartWay code below.

A B C D 1 1 a 1/1/2015 1 2 b 1/2/2015 1 7 c 1/3/2015 2 - a 1/4/2015 3 - b 1/5/2015 3 - c 1/6/2015 3 - a 1/7/2015 3 - b 1/8/2015 4 - c 1/9/2015 4 - a 1/10/2015 5 - b 1/11/2015 5 - c 1/12/2015 6 - a 1/13/2015 6 - b 1/14/2015 6 - c 1/15/2015 7 - a 1/16/2015 7 - b 1/17/2015 7 - c 1/18/2015 

.

Sub LessSmartWay() Set t = Sheets("test") Set r = Sheets("select") Dim d As Integer Dim j As Integer d = 1 j = 2 Do Until IsEmpty(t.Range("A" & j)) If t.Range("A" & j) = t.Range("B2") Or t.Range("A" & j) = t.Range("B3") Or t.Range("A" & j) = t.Range("B4") Then d = d + 1 r.Rows(d).Value = t.Rows(j).Value End If j = j + 1 Loop End Sub  

.

Sub FailedSmartWay() Set t = Sheets("test") Set r = Sheets("select") Dim d As Integer Dim j As Integer Dim i As Integer d = 1 j = 2 i = 2 Do Until IsEmpty(t.Range("B" & i)) Do Until IsEmpty(t.Range("A" & j)) If t.Range("A" & j) = t.Range("B" & i) Then d = d + 1 r.Rows(d).Value = t.Rows(j).Value End If j = j + 1 Loop i = i + 1 Loop End Sub 
added 423 characters in body
Source Link
Feifei Zhang
  • 135
  • 1
  • 3
  • 13

The table looks like this:

A B C D
1 1 a 1/1/2015
1 2 b 1/2/2015
1 7 c 1/3/2015
2 - a 1/4/2015
3 - b 1/5/2015
3 - c 1/6/2015
3 - a 1/7/2015
3 - b 1/8/2015
4 - c 1/9/2015
4 - a 1/10/2015
5 - b 1/11/2015
5 - c 1/12/2015
6 - a 1/13/2015
6 - b 1/14/2015
6 - c 1/15/2015
7 - a 1/16/2015
7 - b 1/17/2015
7 - c 1/18/2015

The table looks like this:

A B C D
1 1 a 1/1/2015
1 2 b 1/2/2015
1 7 c 1/3/2015
2 - a 1/4/2015
3 - b 1/5/2015
3 - c 1/6/2015
3 - a 1/7/2015
3 - b 1/8/2015
4 - c 1/9/2015
4 - a 1/10/2015
5 - b 1/11/2015
5 - c 1/12/2015
6 - a 1/13/2015
6 - b 1/14/2015
6 - c 1/15/2015
7 - a 1/16/2015
7 - b 1/17/2015
7 - c 1/18/2015

Source Link
Feifei Zhang
  • 135
  • 1
  • 3
  • 13

VBA How to select rows that meets multiple criteria from a column in excel?

I am trying to copy and paste the rows based on column A that appears in column B to a new sheet (e.g., copy and paste all rows that contain 1,2, and 7 in column A to a new sheet). I know a less smart way using macro. I believe using a nested loop will make life easier (when column B is a long list), however, mine did not work. Please see my LessSmartWay code and FailedSmartWay code below. Any help will be greatly appreciated.

Sub LessSmartWay() Set t = Sheets("test") Set r = Sheets("select") Dim d As Integer Dim j As Integer d = 1 j = 2 Do Until IsEmpty(t.Range("A" & j)) If t.Range("A" & j) = t.Range("B2") Or t.Range("A" & j) = t.Range("B3") Or t.Range("A" & j) = t.Range("B4") Then d = d + 1 r.Rows(d).Value = t.Rows(j).Value End If j = j + 1 Loop End Sub Sub FailedSmartWay() Set t = Sheets("test") Set r = Sheets("select") Dim d As Integer Dim j As Integer Dim i As Integer d = 1 j = 2 i = 2 Do Until IsEmpty(t.Range("B" & i)) Do Until IsEmpty(t.Range("A" & j)) If t.Range("A" & j) = t.Range("B" & i) Then d = d + 1 r.Rows(d).Value = t.Rows(j).Value End If j = j + 1 Loop i = i + 1 Loop End Sub