Trying to copy partial rows (values only) from sheet1 to sheet2 when 2 criteria are met.

[mikenelena]

Hello, and thanks in advance for any suggestions.

I would like to copy certain partial rows [from columns A-H] from sheet1 to sheet2 if 2 criteria (name and date both match fields in sheet2) are met. I'm about 85% of the way there, but I'm stuck on 2 issues. The first is that the code I have is pasting entire rows, which overwrites my data in downstream columns on Sheet2. I cannot seem to get my mind around a way to limit the copy to columns A-H. (Total novice here.)

The second issue is that I cannot seem to get the range pasted with values only.

If anyone can suggest anything, I would most appreciate it.

Thanks again!

Sub CommandButton1_Click()
    A = Worksheets("Main").Cells(Rows.Count, 1).End(xlUp).Row
        For I = 2 To A
            If Worksheets("Main").Cells(I, 3).Value = Worksheets("Sheet2").Cells(1, 10) And Worksheets("Main").Cells(I, 7).Value = Worksheets("Sheet2").Cells(1, 12) Then
            
                Worksheets("Main").Rows(I).Copy
                Worksheets("Sheet2").Activate
                B = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
                Worksheets("Sheet2").Cells(B + 1, 1).Select
                Worksheets("Sheet2").Paste
                      
            End If
        Next I
Application.CutCopyMode = False
End Sub

 

[vcoolio]

Hello Mikenelena,

Perhaps the following update to your code may work:-

Sub CommandButton1_Click()
        
        Dim lr As Long
        Dim ws As Worksheet, ws1 As Worksheet
  
Set ws = Worksheets("Main")
Set ws1 = Worksheets("Sheet2")

lr = ws.Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False

For i = 2 To lr
      If ws.Cells(i, 3).Value = ws1.Cells(i, 10).Value _
      And ws.Cells(i, 7).Value = ws1.Cells(i, 12).Value Then
      ws.Range(Cells(i, 1), Cells(i, 8)).Copy   '----> Columns A:H only
      ws1.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues  '----> Copies values only to Sheet2 starting in Column A
      End If
Next i

Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub

I hope that this helps.

Cheerio,
vcoolio.

 

[mikenelena]

vcoolio,

Thanks for your reply. I've tried your code, and while it doesn't throw any errors, it doesn't copy any data either. In looking at the differences between my code and your suggestion, I noticed that in this line:

If ws.Cells(i, 3).Value = ws1.Cells(i, 10).Value _
      And ws.Cells(i, 7).Value = ws1.Cells(i, 12).Value Then

you have used "(i, 10 )" and "(i,12)" instead of (1, 10) and (1,12). I tried changing that to see if it made a difference, but it caused a type mismatch error and highlighted this line:

lr = ws.Cells(Rows.Count, 1).End(xlUp).Rows

Your code looks like it should work. I wonder if it's not finding any data because of some mistake in the If statement?

Any further suggestions from anyone would be much appreciated.

Thanks,
Mike

 

[Youngdand]

The below works fine for me when testing.

all i added was a line to activate main, as i found it threw an error trying to paste is ws1 was active.
and i changing (i, 10 )" and "(i,12)" to (1, 10) and (1,12)

the type mismatch might be down to you having .rows instead of .row

You probably will not need the ws.activate as you will be binding to an on click command on the worksheet, but for testing i needed to see what was happening.

Sub test()
        
        Dim lr As Long
        Dim ws As Worksheet, ws1 As Worksheet
  
Set ws = Worksheets("Main")
Set ws1 = Worksheets("Sheet2")

lr = ws.Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False

ws.Activate
For i = 2 To lr
      If ws.Cells(i, 3).Value = ws1.Cells(1, 10).Value _
      And ws.Cells(i, 7).Value = ws1.Cells(1, 12).Value Then
      ws.Range(Cells(i, 1), Cells(i, 8)).Copy   '----> Columns A:H only
      ws1.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues  '----> Copies values only to Sheet2 starting in Column A
      End If
Next i

Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub

 

[mikenelena]

Youngdand,

Thanks for your response. pasteSpecial did not work for me as written, but I modified it as follows, and that corrected it. Compare:

This did not strip the formatting:

ws1.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues

This did strip the formatting:

ws1.Range("A" & Rows.Count).End(3)(2).PasteSpecial Paste:=xlValues

A new issue has cropped up however. The data is pasting over my header rows (I use the first 12 rows for header info.) I suspect I need to modify the paste line to start at row 13, but I don't understand the (3)(2) portion of your suggested line, or how that may be affecting the paste range. Can you tell me what the "(3)(2)" represents in this line of code, and how to get the paste to start at row 13?

Thanks SO much!

...Mike

 

[mikenelena]

OK, I'm apparently overtired... I just realized that in my test file, I'd lost data in the header area, thus freezing the code to place the new data there... still curious what the "(3)(2)" does in the code line though.

...Mike

 

[vcoolio]

Hello Mike,

Apologies. I didn't properly read your original code (perhaps my wife is correct in suggesting that I need glasses!).
It appears then that you are using cells J1 and L1 in Sheet2 as search boxes for names and dates. Thus, the following amended code should work:-

Sub CommandButton1_Click()
        
        Dim lr As Long
        Dim ws As Worksheet, ws1 As Worksheet
  
Set ws = Worksheets("Main")
Set ws1 = Worksheets("Sheet2")

lr = ws.Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False

For i = 2 To lr
      If ws.Cells(i, 3).Value = ws1.Cells(1, 10).Value _
      And ws.Cells(i, 7).Value = ws1.Cells(1, 12).Value Then
      ws.Range(Cells(i, 1), Cells(i, 8)).Copy   '----> Columns A:H only
       ws1.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues   '----> Copies values only to Sheet2 starting in Column A
      End If
Next i

Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub

The type mismatch error is probably due to you typing in "Rows" instead of "Row".
If your last headings row in Sheet2 is row12 then the code will start pasting in row13 starting with Column A.
The line:

ws1.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues

is the same as:

ws1.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlValues

with (3) being the enumeration for xlUp and (2) being the enumeration for Offset(1, 0). The Offset is one row down from your headings row which prevents overwriting of your headings. Using the enumerations is just an abbreviation method of shortening the code.

I hope that this helps.

Cheerio,
vcoolio.

 

[vcoolio]

BTW Mike,

If you wish to run the code from any sheet (but I assume that you run it from Sheet2), change the following line:-

 ws.Range(Cells(i, 1), Cells(i, 8)).Copy

to

ws.Range(ws.Cells(i, 1), ws.Cells(i, 8)).Copy

Cheerio,
vcoolio.

 

[vcoolio]

Hello again Mike,

Another method that is certainly worth looking at, is using the autofilter:-

Sub CommandButton1_Click()

    Dim NmSrch As String, DtSrch As String
    Dim ws As Worksheet, sh As Worksheet
    Set ws = Worksheets("Main")
    Set sh = Worksheets("Sheet2")
    NmSrch = sh.[J1].Value
    DtSrch = sh.[L1].Value

Application.ScreenUpdating = False

ws.[A1].CurrentRegion.AutoFilter 3, NmSrch, 7, , 0
      ws.[A1].CurrentRegion.AutoFilter 7, DtSrch, 7, , 0
           ws.Range("A2", ws.Range("H" & ws.Rows.Count).End(xlUp)).Copy
                sh.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
      ws.[A3].AutoFilter
sh.Range("J1", "L1").ClearContents

Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub

It is a faster and more efficient method especially if your data set is large or will become large.

I hope that this helps also.

Cheerio,
vcoolio.