VBA Match (with multiple matches), Copy and Change Value

[Luke777]

Hi everyone

Here's a table (with nonsensical data) that represents a spreadsheet. "Data 1" = A1 as you'd expect.

What I'm looking for, is how to copy the row (A and B only) where the value of C in that row = "N", change "N" to "Y" (preventing it from being copied again the next time the code runs) and paste the values to another sheet. Pasting to the next blank row on another sheet is something I already have a solution to using:

ThisWorkbook.Sheets("aSheetCalledGerald").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)

However, its the conditional copy function immediately before "ThisWorkbook.Sheets" I'm having trouble with - not even sure where to begin, never mind getting it to check repeatedly.

As you can see, there may be multiple uncopied rows so the code needs to carry on looking for a match with "N" after it has found and copy/pasted the first one - C5 in this example

Data 1​	Data 2​	Copied Y/N​
Steve ​	Turkey​	Y​
John​	Pirate​	Y​
Apple​	515​	Y​
Cricket​	Violin​	N​
HDMI​	Baseball​	N​
Sofa​	Script​	N​
Moon​	Badger​	N​

I should also point out that there will be many blank rows after C8 (in this example) - so a function where it only checks Column C from "C2" to the first blank cell in C would probably be much quicker than checking the entirety of the column - but again, that's way beyond my skills.

Thanks for any help

 

[RustEE2020]

Is this a table? If so you can treat the header like a named range and loop through it checking whether the value for the copied field is yes or no. Then when you get a yes you can create a range using that cell as a reference and copy that to the other page. This will solve your issues with stopping at the first blank.
You can point to a table like this:

Dim TablePointer as Listobject

Set TablePointer = Activeworkbook.Worksheets("TableWorksheet").ListObjects("Table_Name")

Then you can use this pointer to pull data ranges with the header names like so:

Dim TableColumnRange as Range

Set TableColumnRange = TablePointer.Listcolumns("ColumnHeaderName").DatabodyRange

 

[Luke777]

Is this a table? If so you can treat the header like a named range and loop through it checking whether the value for the copied field is yes or no. Then when you get a yes you can create a range using that cell as a reference and copy that to the other page. This will solve your issues with stopping at the first blank.

It's only a table on this forum as I'm not actually with the workbook at the moment, so I'm using it as a representation of the proper spreadsheet - but is your reply still valid if Data 1 is A1 and the final N in the table is C8?

Also thanks for your reply, any and all help is very appreciated

 

[RustEE2020]

It's only a table on this forum as I'm not actually with the workbook at the moment, so I'm using it as a representation of the proper spreadsheet - but is your reply still valid if Data 1 is A1 and the final N in the table is C8?

Also thanks for your reply, any and all help is very appreciated

I would personally turn the data into a table it offers a lot more to work with, I posted some example code above. It would make what you are trying to do easier and you then get added benefits of filters etc.

Also what do you plan to do about duplicate data? Are you writing to a clean worksheet anytime this code will be run?

Something that could possibly remove any need for VBA is a good old pivot table but you would have to determine whether that is viable for your application.
It would allow you to filter that data out and you can do other stuff like get a count of how many duplicate entries etc without VBA.

 

[Fluff]

How about

Sub Luke()
   Dim UsdRws As Long
   With Sheets("Sheet1")
      UsdRws = Range("A" & Rows.Count).End(xlUp).Row
      .Range("A1:C1").AutoFilter 3, "N"
      .AutoFilter.Range.Offset(1).Columns("A:B").Copy Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1)
      .AutoFilter.Range.Offset(1).Resize(UsdRws - 1).Columns("C").Value = "Y"
      .AutoFilterMode = False
   End With
End Sub

Change sheet names to suit.

 

[Luke777]

I would personally turn the data into a table it offers a lot more to work with, I posted some example code above. It would make what you are trying to do easier and you then get added benefits of filters etc.

Also what do you plan to do about duplicate data? Are you writing to a clean worksheet anytime this code will be run?

Something that could possibly remove any need for VBA is a good old pivot table but you would have to determine whether that is viable for your application.
It would allow you to filter that data out and you can do other stuff like get a count of how many duplicate entries etc without VBA.

To explain what I'm actually doing a little further...

Multiple users have their own, personal workbook where they enter information (text) in rows (lets pretend the range for the information is A:B). C is automatically given the value of N once the previous fields (cells A and B) are filled in.

There is then a "master" workbook of sorts, like a database, that when opened, extracts (by opening the individual workbooks, copying and pasting previously uncopied data to the next blank row) the data from the individual workbooks and then closes them again (screen updating off).

 

[Luke777]

How about

Sub Luke()
   Dim UsdRws As Long
   With Sheets("Sheet1")
      UsdRws = Range("A" & Rows.Count).End(xlUp).Row
      .Range("A1:C1").AutoFilter 3, "N"
      .AutoFilter.Range.Offset(1).Columns("A:B").Copy Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1)
      .AutoFilter.Range.Offset(1).Resize(UsdRws - 1).Columns("C").Value = "Y"
      .AutoFilterMode = False
   End With
End Sub

Change sheet names to suit.

Thanks for this

Works quite well with a little tweaking - but I'm really struggling to work out what to adjust if, for example, I wanted extra columns of data and the y/n check to move accordingly.

Specifically, if I have data to be copied in A:M and the y/n check is in N

I thought I'd be able to work this one out for myself but I'm clearly missing something somewhere - I've got it to change n to y in the appropriate column, but for whatever reason it'll no longer copy and paste

 

[Luke777]

Nevermind! sussed it out eventually Thanks for all you help

 

[Fluff]

Glad you sorted it & thanks for the feedback.