Copy Row based on Criteria

lcook1974

Registered User.
Local time
Yesterday, 20:01
Joined
Dec 21, 2007
Messages
330
Good afternoon,
I have a spreadsheet where I need to do the following and I don't think it can be done with formula in a cell.

If Values of Column D in RABU Sheet equal Column D in Adjustment Sheet
Then Copy Row on Adjustment Sheet to "All for Table" sheet.


If Sheet!("RABU & UB")D: D = Sheet("Adj")D: D Then
Sheet!("Admjustment") Copy destanation:=Sheets!("All for Table")
End IF

But I can't seem to get it.
 
You are going to need code, there are many examples of code for copying rows on the forum.

Not too clear on your requirements are you saying if RABU D5 = Adjustment D5 then copy Adjustment Row 5
Or if Adjustment D5 is somewhere in Col D of RABU copy Adjustment row5 ?

Brian
 
I have looked up what I'm trying to use but keep coming across the use of "autofilter". I'm sure that isn't the way I want to go. I'm better in Access but this is something for my wife. :)

What I want it to do is this:

For Each Row in Sheet 3
IF Sheet3!CellD (Number as text) = 'Sheet2!ColumnD' (number as text) Then
Sheet3 Copy Entire Row to Sheet4!
Else
Do Nothing
End If
Next

Does that help in understanding what I'm after?

The latter part of your question:
if Adjustment D5 is somewhere in Col D of RABU copy Adjustment row5
Thanks for the reply! :)
 
This should do the trick

Brian

oops sorry when reread your response got wrong end of stick, I will return. :D

Code:
Sub copyrows()

' Copies a row from sheet2 to sheet3 where col D in that row on Sheet2 Equals Col D
' in the same row on Sheet1.
' It exits as soon as it reaches the last row in either sheet
' B J Warnock

Dim lastrow1 As Long
Dim lastrow2 As Long
Dim rownum1 As Long
Dim rownum2 As Long

lastrow1 = Sheets("sheet1").Range("d65536").End(xlUp).Row
lastrow2 = Sheets("sheet2").Range("d65536").End(xlUp).Row

rownum1 = 1
rownum2 = 1
    Do Until rownum2 > lastrow2
    If Sheets("sheet1").Cells(rownum1, 4) = Sheets("sheet2").Cells(rownum2, 4) Then
    Sheets("sheet2").Rows(rownum2).Copy
       With Worksheets("Sheet3")
        .Rows("1:1").Insert Shift:=xlDown
        .Range("A1").PasteSpecial
       End With
          
    End If
    rownum2 = rownum2 + 1
    rownum1 = rownum1 + 1
    If rownum1 > lastrow1 Then
    Exit Do
    End If
    Loop

Application.CutCopyMode = False
End Sub
 
I have returned.
Try this

Brian

Code:
Sub copyrows()

' Copies a row from sheet2 to sheet3 where col D in that row is in Sheet1 Col D
' ie sheet1 Col D is a list of required values, unsorted
' B J Warnock

Dim lastrow1 As Long
Dim lastrow2 As Long
Dim rownum1 As Long
Dim rownum2 As Long

lastrow1 = Sheets("sheet1").Range("D65536").End(xlUp).Row
lastrow2 = Sheets("sheet2").Range("D65536").End(xlUp).Row

rownum2 = lastrow2

Do
    rownum1 = 1
    Do Until rownum1 > lastrow1
    If Sheets("sheet1").Cells(rownum1, 4) = Sheets("sheet2").Cells(rownum2, 4) Then
    Sheets("sheet2").Rows(rownum2).Copy
       With Worksheets("Sheet3")
        .Rows("1:1").Insert Shift:=xlDown
        .Range("A1").PasteSpecial
       End With
       Exit Do
    Else
    rownum1 = rownum1 + 1
    End If
    Loop
rownum2 = rownum2 - 1
Loop Until rownum2 = 0
Application.CutCopyMode = False

End Sub
 
Great Thanks Brian!

I'll give it a go tonight when she gets home.

Larry
 
Thanks Brian!! Worked great!

I'm going to try to modify it it a bit on other project to look through "All" the forms.

That may be another thread.

Larry

Thank you again!
 

Users who are viewing this thread

Back
Top Bottom