VBA code to copy selected columns from rows that meet a condition to another sheet

1
votes

I've just started out with VBA code for Excel so apologies if this appears basic. I want to do the following...

Check Column J (J5 to J500) of a sheet called "Index" for the presence of value "Y". This is my condition. Then I want to only copy Columns C to I Only of any row that meets the condition to an existing Sheet and to Cells in a different position, i.e. If Index values C3 to I3 are copied I would like to paste them to A5 to G5 of the active sheet i'm in, say Sheet2.

If there is a change to the index sheet I would like the copied data to automatically, If possible. How could it work if new data is added to Index?

After a lot of searching here I found this. From this question I changed the code slightly to suit my requirements and this will copy entire rows that meet the condition to a sheet that I run the macro from, but I'm stumped for how to select certain columns only.

Sub CopyRowsAcross() 

Dim i As Integer 
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Index") 
Dim ws2 As Worksheet: Set ws2 = ActiveSheet 

For i = 2 To ws1.Range("B65536").End(xlUp).Row 
If ws1.Cells(i, 2) = "Y" Then ws1.Rows(i).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1) 
Next i 

End Sub

Any Help is appreciated

John

EDIT: I have created a mock-up and its located at https://docs.google.com/file/d/0B0RttRif9NI0TGl0N1BZQWZfaFk/edit?usp=sharing

The A and B Columns are not required when copied - either is Column J - thats what I am using to check for the condition.

Thanks for all your help so far.

2
excelcopy-pastevba
If you want to be able to run this more than once without first wiping all content from the destination sheet, then you will need to have at least one unique value which can be used to indentify each row, otherwise it's going to be impossible to match rows between the two sheets. – Tim Williams
Thanks for your reply Tim. Thinking about It it might be better to wipe the data and recopy from the Index Sheet when I want to update, e.g. content of the index has changed or a new line has been added. I think that just means I need to manually update by rerunning the macro. I'd be ok with that. Would I thne still need unique references If I were to take that approach? – JohnM

2 Answers

0
votes

Here is the more elegant solution, more similar to my original post. The only difference is that the Cells reference is qualified to the correct sheet. 

Sub try3()
Dim i, x As Long
Dim Y as String
Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Index")
Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2") 'active sheet can get  you into trouble

 x = 5
 Y = "Y"
 For i = 2 To 500:
    If ws1.Cells(i, 10) = Y Then
       Range(ws2.Cells(x, 1), ws2.Cells(x, 7)).Value = Range(ws1.Cells(i, 3), ws1.Cells(i, 9)).Value
      x = x + 1
    End If
 Next i
End Sub

0
votes

That's borrowing some old code. In this you are checking for the last row used, if you know that you only want to go to 500, you can just use the integer:

Sub try2()

  Dim i, Y, x As Long 'you didn't mention what Y was, so it could also be a string.
  Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Index")
  Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2") 'active sheet can get  you into trouble
  Dim Ary1 As Range
  Dim ary2 As Range


   x = 5
   Y = "Y" 'for the sake of argument
         'For i = 2 To ws1.Range("B65536").End(xlUp).Row   This is if you are looking for the last row in MsOf2003 or earlier.  If you know that you are only looking to row 500, then hard code the intiger.
   For i = 2 To 500:
        'If ws1.Cells(i, 2) = "Y" You mentioned you were interested in column J, so we need to change the 2 to 10 (Column B to Column J)
         If ws1.Cells(i, 10) = Y Then
            ws1.Activate
            Set Ary1 = Range(Cells(i, 3), Cells(i, 9))
            ws2.Activate
            Set ary2 = Range(Cells(x, 1), Cells(x, 7)) 'avoid copying all together you don't need it
            ary2.Value = Ary1.Value
            x = x + 1
         End If
   Next i
  End Sub

I'm writing this on a phone not on a compiler, so there may be a syntax error in there and this should be seen as pseudo-VBA code. I can check later to see if you got it to work. You will have to watch out on where you put things if you don't want them to be overwritten.