Use VBA to copy unique rows to another spreadsheet if condition is met-CodePudding

I'm new to VBA and any help would be greatly appreciated!!

My office is coordinating applications for positions across the US. When people apply, they pick which two states they would be willing to work in. All application information is manually entered into Worksheet A, which has a lot of columns, but 5 important ones: Unique ID, First Name, Last Name, Preferred State1, Preferred State2. This worksheet gets updated daily.

I have 50 worksheets (one for each state in the US). I wrote VBA code to copy each row from Spreadsheet A into the 50 state worksheets when the state worksheet is created.

I need to copy the new information that is added to Spreadsheet A every day into the appropriate state spreadsheets. All applicants who picked a state need to go into the state worksheet (the state order of preference doesn't matter).

For example, today, Spreadsheet A could be:

ID	First Name	Last Name	State1	State2
111	Bob	Belcher	New Jersey	Alaska
222	Rose	Nylund	Minnesota	Florida
333	Beef	Tobin	Alaska	California

So the Alaska spreadsheet would have:

ID	First Name	Last Name
111	Bob	Belcher
333	Beef	Tobin

Tomorrow, Worksheet A could have new people added (IDs 444 and 555) and I would only want to add the new people who picked Alaska to the Alaska worksheet (ID 555 Colin Robinson).

ID	First Name	Last Name	State1	State2
111	Bob	Belcher	New Jersey	Alaska
222	Rose	Nylund	Minnesota	Florida
333	Beef	Tobin	Alaska	California
444	Charlie	Bucket	New York	Florida
555	Colin	Robinson	New York	Alaska

I was using this code based on unique IDs in Column A, but it doesn't account for the different states.

Sub Copy ()
Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheet4
Set sh2 = Sheet1
lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh1.Range("B2:B" & lr)
For Each c In rng
    If WorksheetFunction.CountIf(sh2.Range("B:B"), c.Value) = 0 Then
        sh2.Range("B" & sh2.Cells(Rows.Count, 1).End(xlUp).Row)(2).Resize(1, 5) = c.Resize(1, 5).Value
    End If
Next
End Sub

CodePudding user response：

Here is how I would do it if the only macro I wanted was to be in Spreadsheet A and you just wanted to use copy-paste to transfer data versus sql.

Note: The items below with a *, you can record a macro to generate the code for you and paste it in your function to cobble together the code pretty quickly.

First set ScreenUpdating=false to eliminate the screen from flashing.
Create an array of the state names to loop through.
In the loop, apply a filter to the spreadsheet to reduce the rows to just one's that match the current "state"*
Open the other file - be sure to name the file with the state name so you can reference the filename with the array. (see Workbooks.Open)
Paste by inserting rows at A1* of the state spreadsheet.
Select All and do a menu option Data-->Remove Duplicates*

If you have data that makes #6 a problem, then there will be some more code required to check for existing.

See ya, Sean

CodePudding user response：

In the For loop before the If, add

Set sh2 = ThisWorkbook.Worksheets(c.Offset(, 3).Value2)

This requires that the values in the State columns exactly matches the state sheet names

To process the second state repeat the Set and If block, using Offset(, 4)

If this code is too slow, consider switching to a Variant Array approach