VBA code to select rows

[ub]

Hi
I want to write a vba code in "Sheet2", to select rows from "Sheet1" based
on my condition and then paste those rows in defined range in "Sheet2"
Example
I want to select rows in sheet1 where the condition is that cell value
c3=d3, I have 500 rows. Now the rows that meet the condition, I want them to
be displayed in sheet 2 in the cell range starting from a20 to a2000
Please advise

 

[Chip Pearson]

Try the following code. Change the lines marked with <<< to the
appropriate values. Src should be set to the first cell of data on
Sheet1, column C. Dest should be set to the first cell where the data
is to be written on Sheet2. NumColumnsToCopy is the number of columns
from Sheet1 that should be written to Sheet2 if a match between C and
D is found. The code will loop down from the Src cell until a blank
value is found.


Sub AAA()
Dim Src As Range
Dim Dest As Range
Dim NumColumnsToCopy As Long
NumColumnsToCopy = 5 '<<< CHANGE
Set Src = Worksheets("Sheet1").Range("C3") '<<<< CHANGE
Set Dest = Worksheets("Sheet2").Range("A1") '<<<< CHANGE
Do Until Src.Text = vbNullString
If StrComp(Src.Text, Src(1, 2).Text, vbTextCompare) = 0 Then
Dest.Resize(1, NumColumnsToCopy).Value = _
Src.Resize(1, NumColumnsToCopy).Value
Set Dest = Dest(2, 1)
End If
Set Src = Src(2, 1)
Loop
End Sub

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[CurlyDave]

Hi
I want to write a vba code in "Sheet2", to select rows from "Sheet1" based
on my condition and then paste those rows in defined range in "Sheet2"
Example
I want to select rows in sheet1 where the condition is that cell value
c3=d3, I have 500 rows. Now the rows that meet the condition, I want them to
be displayed in sheet 2 in the cell range starting from a20 to a2000
Please advise

Try this, hopefully you will have a heading in A19

Sub Button1_Click()
Dim r As Range
Dim c As Range

Set r = Worksheets("Sheet1").Range("C1", Worksheets("Sheet1").Range
("C65536").End(xlUp))

For Each c In r.Cells
If c = c.Offset(0, 1) Then
c.EntireRow.Copy Destination:=Worksheets("Sheet2").Range
("A65536").End(xlUp).Offset(1, 0)
End If
Next c

End Sub

 

[Bernard Liengme]

Here's my 2 cents worth: it works with a selection as you asked

Sub tryme()
firstrow = ActiveCell.Row
lastrow = Selection.Rows.Count
j = 1
For k = firstrow To lastrow
If Cells(k, "C") = Cells(k, "D") Then
Cells(k, "A").EntireRow.Copy Worksheets("sheet2").Cells(j, "A")
j = j + 1
End If
Next k
End Sub

 

[ub]

Hi
The code line
Do Until Src.Text = vbNullString

Loop

Gives following error " Runtime error - 6 , Overflow"

Please advise