PDA

View Full Version : Solved: copy rows on criteria



farrukh
10-06-2011, 11:51 AM
HI All

I have two excel sheets one is adjustable other is fixed. I need that the adjustable sheet follow the sequence of fixed sheet and based on Fixed sheet column A. Give the result in result tab, if result tab is not created. It auto create the result sheet,in adjustable sheet copy the whole row based on the sequence Column A of fixed sheet.

* My first sheet is name adjustable second is fixed.
* i need that find string in adjustable sheet suppose "HI" then look in (fixed sheet) where the name "HI" exist if "HI" is place at column A row 12 then copy the entire row of adjustable sheet in new sheet which is result sheet at row 12?

I need to to with all strings in the adjustable sheet?

The sample file is attached with.

thanks
hammeed

mancubus
10-07-2011, 12:18 AM
hi.

try this.

Sub find_copy_rows()

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim adjustRng As Range, findthisCell As Range
Dim fixedRng As Range, foundCell As Range
Dim findString As String, foundRow As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False

On Error Resume Next
Set ws1 = Worksheets("adjustable")
Set ws2 = Worksheets("fixed")
Set ws3 = Worksheets("result")
If ws3 Is Nothing Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "result"
End If
On Error GoTo 0

Set adjustRng = ws1.Range("A1:A" & ws1.Cells(Rows.Count, 1).End(xlUp).Row)
Set fixedRng = ws2.Range("A1:A" & ws2.Cells(Rows.Count, 1).End(xlUp).Row)

ws3.UsedRange.Clear

For Each findthisCell In adjustRng
findString = findthisCell.Value
Set foundCell = fixedRng.Find(What:=findString, after:=Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext)
If Not foundCell Is Nothing Then
foundRow = foundCell.Row
ws1.Rows(findthisCell.Row).EntireRow.Copy Destination:=ws3.Rows(foundRow)
End If
Next

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

farrukh
10-08-2011, 12:28 PM
HI mancubus, (http://www.vbaexpress.com/forum/member.php?u=37987)

Thank you so much for your kind help, this code worked like a charm. I just comment out end if both it worked for me. Thank you so much for your kind support.

God Bless you and this forum Moderators.

Thanks
farrukh

mancubus
10-08-2011, 01:57 PM
youre wellcome farrukh.
glad it helped.

pls mark the thread as solved from thread tools.

farrukh
10-08-2011, 02:14 PM
hi