Filter By Multiple Criteria then match results to different workbook & paste new data

[KathCobb]

Hello All,

I am trying to modify some bits of code I have to do another task. I am sure there is probably a more efficient way to do what I am doing but I muddle through with what I can get to work--there is a lot I do not understand with VBA but I try. What I am trying to accomplish is:

Filter By Multiple Criteria in Sheet1 (This workbook's Name and sheet name will change every week so I am trying to incorporate getting the book and sheet name into the code.)

Then in Column F of Sheet1 check each value to see if it Matches to Sheet2, if yes copy a value in same row of Sheet 1 but column S ( a decimal) and paste into Sheet2 matching row column 12
This repeats based on different Filtering Criteria. The code below is what I was trying to modify to work but I don't think the way this function is set up that it skips anything that is filtered out. Another issue is that the number rows of each sheet will change each week.

I had this working at first to at least put the values of Sheet1 Columns S into Sheet2 Column K but for some reason it will work for any other column except S. I don't know why, I use this in another worksheet and it does not have an issue with decimals. Also the Range S2:S10500 is random because the number of rows changes.

Is there any way to accomplish what I am trying to do? Basically I get sent a list of text/numbers(as the identifier), then several other columns of info. I need to filter these other columns by person and by types then copy the dollar amount in a specific column and find the matching text/number identifier in a different running list and paste the copied amount into the correct columns.


Sub Copy_With_AutoFilter1()
Dim My_Range As Range
Dim FilterCriteria As String
Dim sheetName As String
Dim LR As Long
Dim strWBName As String
Dim sht As String

strWBName = ActiveWorkbook.Name
sht = ActiveSheet.Name

Set My_Range = ActiveSheet.Range("A1:U" & LastRow(ActiveSheet))

My_Range.Parent.Select

'Check if workbook is protected
If ActiveWorkbook.ProtectStructure = True Or My_Range.Parent.ProtectContents = True Then
MsgBox "Sorry, not working when the workbook or worksheet is protected", _
vbOKOnly, "Copy to new worksheet"
Exit Sub
End If

'Firstly, remove the AutoFilter
My_Range.Parent.AutoFilterMode = False

' Set Filter Criteria-Jeff
With My_Range
.AutoFilter Field:=4, Criteria1:="Jeffrey Williams" '
.AutoFilter Field:=16, Criteria1:="=Rated Replacement", Operator:=xlOr, Criteria2:="=Replacement"
End With

For Each cell In Workbooks("Sheet2.xlsx").Sheets("Jeff").Columns(4).Cells
returnValue = myLookupFunction(cell.Value, Workbooks(strWBName).Worksheets(sht).Range("F2:F10500"), _ Workbooks(strWBName).Worksheets(sht).Range("S2:S10500"))
If returnValue <> "No Match" Then cell.Offset(, 7).Value = returnValue
Next cell

My_Range.Parent.AutoFilterMode = False

With My_Range
.AutoFilter Field:=4, Criteria1:="Jeffrey Williams" '
.AutoFilter Field:=16, Criteria1:="=New Includes Value", Operator:=xlOr, Criteria2:="=Rated New Includes Value"
End With

For Each cell In Workbooks("Sheet2.xlsx").Sheets("Jeff").Columns(4).Cells
returnValue = myLookupFunction(cell.Value, Workbooks(strWBName).Worksheets(sht).Range("F2:F10500"), _
Workbooks(strWBName).Worksheets(sht).Range("S2:S10500"))
If returnValue <> "No Match" Then cell.Offset(, 7).Value = returnValue
Next cell

My_Range.Parent.AutoFilterMode = False
With My_Range
.AutoFilter Field:=4, Criteria1:="Jeffrey Williams" '
.AutoFilter Field:=16, Criteria1:="=*CB*", Operator:=xlAnd
End With

For Each cell In Workbooks("Sheet2.xlsx").Sheets("Jeff").Columns(4).Cells
returnValue = myLookupFunction(cell.Value, Workbooks(strWBName).Worksheets(sht).Range("F2:F10500"), _ Workbooks(strWBName).Worksheets(sht).Range("s2:S10500"))
If returnValue <> "No Match" Then cell.Offset(, 8).Value = returnValue
Next cell
MsgBox "Done"
End Sub


Any help on this would be greatly appreciated. I am really struggling to figure out why it worked briefly--even if incorrectly and now it won't return any values at all even if I use the actual workbook/sheet names instead of a string.

Thanks so much,

Kathy

[Aussiebear]

Kathy, what is this line meant to be doing?


'returnValue = myLookupFunction(cell.Value, Workbooks(strWBName).Worksheets(sht).Range("F2:F10500"), Workbooks(strWBName).Worksheets(sht).Range("S2:S10500"))

Do we not know the names of the workbook and or sheet for these ranges? If this actually one line of code then shouldn't we be using (Space underscore) to wrap the text to the next line otherwise the comma behind F2:F10500 needs to be removed?

[KathCobb]

Hello and thank you for having a look.

First Up, I went back and edited the original post and tried tomato it a little easier to read. My apologies.

There are several things happening in this section I rewrote it below using actual names BUT I was trying to get the Workbook and Worksheet names via code because they will change each week. See below


returnValue = myLookupFunction(cell.Value, Workbooks("10-21-2022 WC.xlsx").Worksheets("10-21-2022").Range("F2:F17"), Workbooks("10-21-2022 WC.xlsx").Worksheets("10-21-2022").Range("S2:S17"))
If returnValue <> "No Match" Then cell.Offset(, 2).Value = returnValue
Next cell




The Book and Sheet name, I am trying to pick up at the top of the code after the Dim statements. Next, there is a function that goes with that code. I did not write this function, it was given to me and I utilize it often) Basically as I understand it, this line is doing what I need--Look in Specified Column of Sheet2 then Go to Sheet 1 and find the matches, get the data from the Column specified and put its value over into Sheet2 (Offset from the original column)
See Below for myLookUp Function:

Function myLookupFunction(lookupval, findrange As Range, returnrange As Range)
Dim matchPos
matchPos = Application.Match(lookupval, findrange, 0)
If IsError(matchPos) Then
myLookupFunction = "No Match"
Else
myLookupFunction = returnrange.Cells(matchPos).Value
End If
End Function




SO here is what I am trying to accomplish: I have Sheet1 as my Active Sheet. I go to my code window to run the code, I want my code to

1. get the workbook and worksheet names of the active sheet and store it in a variable.
2. Filter the active sheet(Sheet1) by Column D and then again two criteria of Column P
3. Next Column F of Sheet1 will have a matching value to Column D of Sheet2.
3. If a match is found in Sheet2, copy the value of the same matched row of Sheet1, Column S and Paste this value into Sheet2 Column K
4. Remove the filter and then a new filter should start.

I do not have to use any of the code I have, it was just my attempt to piecemeal some things together and see if I could make it work. I had it working for a minute but then I changed something and now for some reason if I use any column after C in the code, it will not copy the value. I'm stumped on that. I'm not much of a code writer. But this would save me a bundle of time if I could figure out a way to make it happen.

Thank you,

Kathy

[p45cal]

You probably don't need to 'get the workbook and worksheet names of the active sheet and store it in a variable', you only need to set a variable to that sheet and use that in the code.
I'm not sure your autofiltering is having any effect on the results!
I suspect you'll be able to use one of the built-in functions instead of the myLookupFunction.
Workbooks("Sheet2.xlsx").Sheets("Jeff").Columns(4) is an awful lot of cells to iterate through! We can reduce that but not sure the best way at the moment.
In the line If returnValue <> "No Match" Then cell.Offset(, 7).Value = returnValue, if there is no match than cell.offset(,7) remains unaffected; is there likely something in there that needs conserving?
There's a function LastRow we don't know anyhting about.
The three autofilters towards the end of the macro can probably be combined to one (if we need to autofilter at all).

I think there can be some quite short code to do what you want but it's a guessing game at the moment because I have no real sheets to work with.
Best attach workbooks and describe how they interact.

Important: What version of Excel are you using?

In the meantime, although I don't advocate using it, the code below should do exactly the same as your existing code but you'll see how I've slightly streamlined it.
It needs a re-write, and for that I'll need to see some real workbooks with realistic data in them so we can test.

A bit of code:
Sub Copy_With_AutoFilter1()
Dim Colm4, cll, returnValue
Dim My_Range As Range
Dim sht As Worksheet 'was String

Set Colm4 = Workbooks("Sheet2.xlsx").Sheets("Jeff").Columns(4)
'maybe instead:
'With Workbooks("Sheet2.xlsx").Sheets("Jeff")
' Set Colm4 = Intersect(.UsedRange, .Columns(4))
'End With

Set sht = ActiveSheet
Set My_Range = sht.Range("A1:U" & LastRow(sht))
If sht.Parent.ProtectStructure Or sht.ProtectContents Then
MsgBox "Sorry, not working when the workbook or worksheet is protected", vbOKOnly, "Copy to new worksheet"
Exit Sub
End If
'Firstly, remove the AutoFilter
sht.AutoFilterMode = False
' Set Filter Criteria-Jeff
With My_Range
.AutoFilter Field:=4, Criteria1:="Jeffrey Williams" '
.AutoFilter Field:=16, Criteria1:="=Rated Replacement", Operator:=xlOr, Criteria2:="=Replacement"
End With
For Each cll In Colm4.Cells '1000000+ cells!
returnValue = myLookupFunction(cll.Value, sht.Range("F2:F10500"), sht.Range("S2:S10500"))
If returnValue <> "No Match" Then cll.Offset(, 7).Value = returnValue
Next cll
My_Range.AutoFilter Field:=16, Criteria1:="=New Includes Value", Operator:=xlOr, Criteria2:="=Rated New Includes Value"
For Each cll In Colm4.Cells '1000000+ cells!
returnValue = myLookupFunction(cll.Value, sht.Range("F2:F10500"), sht.Range("S2:S10500"))
If returnValue <> "No Match" Then cll.Offset(, 7).Value = returnValue
Next cll
My_Range.AutoFilter Field:=16, Criteria1:="=*CB*", Operator:=xlAnd
For Each cll In Colm4.Cells '1000000+ cells!
returnValue = myLookupFunction(cll.Value, sht.Range("F2:F10500"), sht.Range("s2:S10500"))
If returnValue <> "No Match" Then cll.Offset(, 8).Value = returnValue
Next cll
MsgBox "Done"
End Sub

[KathCobb]

Thank you for the Response. I did some googling and I believe I am making this process too complicated with trying to adapt my Lookup Function. I think there may be a simpler method but I do not know it. I have attached two sample excel workbooks. "Sheet2" is a master list and it's name will never change. Workbook 10-21-2022 will change every week and will be named by the date received. Which why I wanted to get the name of the workbook and worksheet somehow as part of the code, so I do not have to change my code every single week. The working sheet is also named the same date. Using the samples, this is what I am trying to accomplish:

In Sheet 10-21-2022 filter by Column D. In this example I used "Jeffrey Williams" then Filter by at least 2 criteria. For this example it would be "Rated Replacement" or "Replacement" (meaning I want both of this in the filter if they appear) in Column P.

Using Column F in 10-21-2022, find the matching text in workbook Sheet2 Column D on Sheet "Jeff". If a match is found copy the amount in Sheet 10-21-2022 column S and paste into Sheet2 Column K.

I would also like to paste in Column J of Sheet2 the name of either the workbook or tab of workbook 10-21-2022. This book/sheet will always be named the date I need.

I will then repeat this for different criteria in Column P but still with "Jeff" in Column D of 10-21-2022.

Because I do not know any better, I then repeat everything I do for Sheet2/Jeff for 18 other members of our team in separate sub routines that are called by the previous sub. I don't mind doing that, once it is written I rarely have to change it. But if there is a suggestion to do it differently, I'd appreciate that as well.

Thank you so much for having a look at my problem.
Kathy

[p45cal]

So can we put the vba code in Sheet2.xlsx, instead of being in a third workbook somewhere? Or have you plans to put it elsewhere?
Can the sheet to work on be determined by it being the active sheet at the time the macro is started? Or maybe it can be the only other workbook open at that time?
I see there are more names/sheets in Sheet2.xlsx, will you want to be doing the same to them as you're doing with Jeff from the same 10-21-2022.xlsx file?
Is the 10-21-2022.xlsx file as you get it, or do you load it into an Excel file yourself?

Again:

In the line If returnValue <> "No Match" Then cell.Offset(, 7).Value = returnValue, if there is no match then cell.offset(,7) remains unaffected; is there likely something in there that needs conserving? (It seems to be going into the Prior column.
There's a function LastRow we don't know anything about. Can we see it?
Important: What version of Excel are you using?

[KathCobb]

So can we put the vba code in Sheet2.xlsx, instead of being in a third workbook somewhere? Or have you plans to put it elsewhere?
I run all my code from the personal macro workbook. It is just easier for me as I work throughout the day running multiple codes.
Can the sheet to work on be determined by it being the active sheet at the time the macro is started? Or maybe it can be the only other workbook open at that time?
​I was hoping to get away from "Active Workbook" because I always have several workbooks open at once and find this being an issue that I actually have a message box appear before every code using active workbooks starts asking me to verify what workbook I am in.
I see there are more names/sheets in Sheet2.xlsx, will you want to be doing the same to them as you're doing with Jeff from the same 10-21-2022.xlsx file?
I sure will. with a total of 18 other names.
Is the 10-21-2022.xlsx file as you get it, or do you load it into an Excel file yourself?
I receive a cvs file. Run other code that creates multiple worksheets for different purposes and then saves the file as the date as an xlsx. At this stage is where I would want to run the copy paste code.

Again:

In the line If returnValue <> "No Match" Then cell.Offset(, 7).Value = returnValue, if there is no match then cell.offset(,7) remains unaffected; is there likely something in there that needs conserving? (It seems to be going into the Prior column. ​I honestly do not know the answer to this. The code was given to me. But if there is not a match, it moves on to look in the next cell and start looking for another match.
There's a function LastRow we don't know anything about. Can we see it?
I have this code for years. It was also provided to me.

Function lastRow(sh As Worksheet) On Error Resume Next
lastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).row
On Error GoTo 0
End Function
Important: What version of Excel are you using?
Excel 2019




Thank you so much for helping me with this :)
Kathy

[p45cal]

A few more questions:
Q1.
You have 2 separate loops filtering thus:
.AutoFilter Field:=16, Criteria1:="=Rated Replacement", Operator:=xlOr, Criteria2:="=Replacement"
.AutoFilter Field:=16, Criteria1:="=New Includes Value", Operator:=xlOr, Criteria2:="=Rated New Includes Value"

I want to bring this into one loop, the equivalent of a single filter:
.AutoFilter Field:=16, Criteria1:=Array("Rated Replacement", "Replacement", "New Includes Value", "Rated New Includes Value"), Operator:=xlFilterValues
which filters for all 4 values at once.

However, you may have a good reason you've done this in two loops - have you? (An example might be that if it finds one row to fulfil the 2 criteria for column 16 in the second loop you want it to overwrite a different row found in the first loop)

I won't use an autofilter (your code takes no notice of any autofilter, by the way) I'm just trying to make the code fast.

Q2.
Related to Q1, my question "In the line If returnValue <> "No Match" Then cell.Offset(, 7).Value = returnValue, if there is no match then cell.offset(,7) remains unaffected; is there likely something in there that needs conserving?" needs clarifying:
If there are already values in columns K and L of the Jeff sheet, values found in the 10-21-22 sheet will overwrite them. Fine, you say, that's the intention, but, your code, if it finds an empty cell to copy over to one of those columns K and L will copy that empty value over the pre-existing value (effectively deleting the previous value on the Jeff sheet). In such a case are you happy to lose the previous value?

Q3.
Roughly what's the largest number of rows of data that a 10-21-22-type sheet can have?

Separately, for multiple sheets, you'll need a way of translating the name of a sheet to a name to search for; in this one case Jeff became JEFFREY WILLIAMS, we'll need the rest.

I'm working on this only sporadically; forgive the slow progress.

[KathCobb]

A few more questions:
Q1.
You have 2 separate loops filtering thus:
.AutoFilter Field:=16, Criteria1:="=Rated Replacement", Operator:=xlOr, Criteria2:="=Replacement"
.AutoFilter Field:=16, Criteria1:="=New Includes Value", Operator:=xlOr, Criteria2:="=Rated New Includes Value"

I want to bring this into one loop, the equivalent of a single filter:
.AutoFilter Field:=16, Criteria1:=Array("Rated Replacement", "Replacement", "New Includes Value", "Rated New Includes Value"), Operator:=xlFilterValues
which filters for all 4 values at once.

However, you may have a good reason you've done this in two loops - have you? (An example might be that if it finds one row to fulfil the 2 criteria for column 16 in the second loop you want it to overwrite a different row found in the first loop)
No reason. I just didn't know how to do more than two criteria at a time.
FYI, there will need to be a second and third set of criteria to check with pasting into different columns in Sheet2.
I will need to filter by anything containing "CB" 10-21-2022 Column then copy the value in Column S and pasting to Sheet2 but it will be in Column L (date will need to be in Col M)
Then it will need to look for "Full Value" and "Rated Full Value" in 10-21-2022 Column and copy the value in Column S but paste this to Column N (date will need to be in Col O)

I won't use an autofilter (your code takes no notice of any autofilter, by the way) I'm just trying to make the code fast.

Q2.
Related to Q1, my question "In the line If returnValue <> "No Match" Then cell.Offset(, 7).Value = returnValue, if there is no match then cell.offset(,7) remains unaffected; is there likely something in there that needs conserving?" needs clarifying:
If there are already values in columns K and L of the Jeff sheet, values found in the 10-21-22 sheet will overwrite them. Fine, you say, that's the intention, but, your code, if it finds an empty cell to copy over to one of those columns K and L will copy that empty value over the pre-existing value (effectively deleting the previous value on the Jeff sheet). In such a case are you happy to lose the previous value?
I apologize I didn't understand earlier, the answer is No I cannot lose any values on Sheet2 that are already there.

Q3.
Roughly what's the largest number of rows of data that a 10-21-22-type sheet can have?
The maximum would be 5,000 but usually under 500.

Separately, for multiple sheets, you'll need a way of translating the name of a sheet to a name to search for; in this one case Jeff became JEFFREY WILLIAMS, we'll need the rest.
​Is this something you can show me how to do myself in case I need to add additional sheets? Would you like me to list the names here that I have now?

I'm working on this only sporadically; forgive the slow progress.
I appreciate any and all help given. If I can get this to work it would save me countless hours of receptive toiling each week. Thank you so much for taking the time you have

[p45cal]

Work in progress.
Is this correct?
30281

[KathCobb]

There should not be a duplicate on Sheet2. Only 10-21-2022. That is my fault if there is a duplicate in the sample. Otherwise yes that looks correct :yes:)

[p45cal]

I've attached a new version of Sheet2.xlsx containing a new sheet Control that you can hide if you want. It contains a table (called OurNamesSheetNames) of sheet names and corresponding Our Names which you should add to.
If a sheet name in the table doesn't exist in the workbook it will not do anything (but can tell you if you want (see comments in code)). If an Our Name doesn't exist in the source data it won't bother running through 5000 rows of source data (speeds things up).
This workbook also contains added data to sheets Bill and Alesha for testing (Sheet Bill doesn't end up being updated because the first row found in the new source data contains no value in column S
Also attached is code for the single macro blah in the file vbaExpress70333Code.xlsm for you to to copy to somewhere in your personal.xlsb.
There are lots of comments in the code, some commented-out lines which you can include or not.
The aim is to start with your new data sheet as the active sheet (you could add some code to get the user to confirm that the active sheet is the right sheet).
To speed up the code, I copy the entire new source sheet's data into memory to avoid multiple reads from that sheet. It's a once-only read for the entire macro. I can't say the same for writing to the sheet!
The code is quite wordy and could be considerably shortened; I used lots of variables so that I could easily check each step of the code. This will make it easier to add to the code to accommodate the extra data-copying you want over the original requirement.

Some code is designed for development/debugging only; one such uses the variables FoundCount and CBFoundCount to alert if there are multiplerows in the new source data meeting all the filters. It will help you decide how to handle them. At the moment, like your original code, it will only use the first found one, but that may not be the one you want to use.

Regarding over-writing existing data in the destination sheets, this code first looks to see if the cell to be copied from is empty. If it is then no copying takes place. If it's not empty then copying does take place, regardless of what is in the destination cell beforehand, that is, overwriting does take place.

So first of all, check that this code begins to do properly what you want it to, before we add to it.

[KathCobb]

Thank you so much for this...I wanted to let you know I may not get an opportunity to test it until after the weekend. But I will report back as soon as I can. I am very excited to try it out. THANK YOU SO MUCH! :):)

[KathCobb]

Hello gain and thank you so much for all you have done. I had an opportunity to test it out and I have two issues.

1. I added all my names to the control worksheet and they are not working. Is it case sensitive? The code works great for any name that was previously in the Control sheet but it will not work for the added names. Was I supposed to do something after I added the names? I've saved and closed out and reopened to try if that would help and it did not.

2. For the "CB" filter: That is not an exact term. There will be CB XXXX and other CB values that will all go in the same column. Is it possible to use a wild card for anything that has CB and any text after it?

3. I am finding that I need am going to need to "trim" some of the columns to make sure we are getting the correct filter terms. I have this code below that works on the active sheet but I am terrible at loops and do not know how to incorporate it to loop through each worksheet in Sheet2 and Trim all values in Column D. Is it possible to make this into a loop?


Sub TrimText()
Dim MyRange As Range




Set MyRange = ActiveSheet.Range("D1:D" & lastRow(ActiveSheet))

For Each cell In MyRange
cell.Value = Trim(cell)
Next


End Sub


Thank you so much for all you have done so far! All the comments in the code are very helpful for me to try and follow along what is happening. Much appreciated.

[p45cal]

You've made sure that the new names on the Control sheet are included in the table? The little grab handle bottom right of the table shows the extent of the table:
30292
The names in both the columns must be an exact match for the sheet names and OurNames. Trailing, leading and double or treble spaces should match.
We could code for a little flexibility with OurName matching Last Name but it's more convoluted to do the same for sheet names.
Also, check the Last Name in column C of the individual's own sheet is consistent; look at the two Jackmans at cells C9 and C10 of the Jeff sheet. One has a leading space.
Column P of the new data sheet also has a few leading spaces, see cell P13 of the 10-21-2022 sheet. It doesn't matter in this case since we're not looking for Pro-Rated Over, we're just looking for "Rated Replacement", "Replacement", "New Includes Value"and "Rated New Includes Value" but these at least should be an exact match (upper- lower-case doesn't matter).

The following will trim column D in ALL the sheets of the active workbook:
Sub TrimText()
Dim MyRange As Range
For Each sht In ActiveWorkbook.Worksheets ' ALL sheets in the active workbook.
Set MyRange = sht.Range("D1:D" & lastRow(sht))
For Each cll In MyRange.Cells
cll.Value = Application.Trim(cll) 'APPLICATION.Trim also trims multiple spaces WITHIN a string, not just the ends.
Next cll
Next sht
End Sub


CB is already being sought wildcard fashion. That's what If InStr(SourceVals(rw, 16), "CB") > 0 is about.

If you're still having issues, attach the various files here. If you don't want them to be in the public domain because of sensitive data, but you're happy for just me to look at them, then Private Message me here to arrange for me to get sight of them somehow.

[KathCobb]

Hello :)

Since I had my doubts that there were not spacing issues in one or all the relevant columns, I created a completely separate set of test data and started from scratch. The code worked like a charm. So then I went back one stage at time to my actual data.

I've edited this coment 5 times...but now I think I know what is the problems are.

1. In my actual workbooks, there are blank rows between each name grouping. So Jeff always works because he is the always the first data set on the weekly sheets. If I remove the blank rows, the code works for everyone. Do I have to remove the blank rows each time or can the code be adjusted to ignore? I can add some code to copy the sheet and remove them if needed.

2. It does appear that some names have to be a case match..I do not know why that only seems to be the issue occasionally. I ran the code, one of OurNames was in Proper Case in Sheet2, but in 10-21-2022 the name is in all caps. I changed our name to all caps and ran again, and it worked. Is this just a coincidence?

On the bright side, In my testing, the code ran extremely fast and I am very happy to have come this far. I cannot thank you enough! I will message you to get you a better sampling of data so you can have better test info in case I am doing something incorrectly. And if you are willing, hopefully we can figure out what i am doing incorrectly add then a few other criteria. :)

[p45cal]

1. In my actual workbooks, there are blank rows between each name grouping. So Jeff always works because he is the always the first data set on the weekly sheets. If I remove the blank rows, the code works for everyone. Do I have to remove the blank rows each time or can the code be adjusted to ignore?
Untested, try changing:
SourceVals = ActiveSheet.Cells(1).CurrentRegion.Value
to:
SourceVals = ActiveSheet.Cells(1).CurrentRegion.Resize(lastRow(ActiveSheet))



2. It does appear that some names have to be a case match..I do not know why that only seems to be the issue occasionally. I ran the code, one of OurNames was in Proper Case in Sheet2, but in 10-21-2022 the name is in all caps. I changed our name to all caps and ran again, and it worked. Is this just a coincidence? No, it's case sensitive. To render it case insensitive, change:
If SourceVals(rw, 4) = OurName Then
to:
If Lcase(SourceVals(rw, 4)) = Lcase(OurName) Then


I will message you to get you a better sampling of data so you can have better test info in case I am doing something incorrectly. And if you are willing, hopefully we can figure out what i am doing incorrectly add then a few other criteria. :)Bed time here, Tomorrow.

[KathCobb]

Hello :)

The tow changes seem to work only test data=. :clap: I sent a PM with a link to the data, i hope it went through.

Thanks again too much for this :)

[p45cal]

I sent a PM with a link to the data, i hope it went through.No PM received…

[KathCobb]

resent. Thanks so much for sticking with me :)