I need Experts help to add additional function in the attached script. Currently the script is used to update automatically data from Column B (Listing sheet) into Column G (Data sheet) if data at Column E cell (Data sheet) is matched with the data at Column A (Listing sheet).
The new function that need to add in this script is to prevent the same data from Column B (Listing sheet) being inserted on the same date at the Column G (Data sheet) if the timing at Column D (Data sheet) has been clashed. If the data at Column G is clashed with other data within the same date, the next possible option to replace is by choosing a vacant (not being used on other cell within the same date) data from Listing sheet from range B5:B16.
e.g. Data at cell E4 and E5 are sharing the same data from Listing sheet "Title 14". Since the time (Column D) at cell D4 and D5 are clashed between 19:00 - 19:30, hence, cell D5 data need to be replaced with any available data from Range B5:B16.
Another Example is at Cell E9 and E10. Both Cells at Column G sharing the same Code whereby the timing have been clashed; between 21:00 - 22:15. Therefore Cell at G10 need to replaced with any vacant data from Range B5:B16 (Listing sheet). Hope Experts able to add this function. Attached the workbook for Experts perusal.
Sub CopyCode()Dim r As Range, Rng1 As Range, Rng2 As Range, rng3 As RangeDim sFAddress As String, sCriteria As StringsCriteria = "Incoming ,Outgoing" '<--Modify criteria as necessaryWith Sheets("Listing") Set Rng1 = .Range(.Range("A2"), .Cells(Rows.Count, 1).End(xlUp))End WithWith Sheets("Data") Set Rng2 = .Range(.Range("E2"), .Cells(Rows.Count, 1).End(xlUp))End WithFor Each r In Rng1 Set rng3 = Rng2.Find(r, Rng2.Cells(1), xlValues, xlPart) If Not rng3 Is Nothing Then sFAddress = rng3.Address Do If InStr(1, sCriteria, rng3.Offset(, 1)) <> 0 Then rng3.Offset(, 2) = r.Offset(, 1) Set rng3 = Rng2.FindNext(rng3) Loop While Not rng3 Is Nothing And rng3.Address <> sFAddress End IfNext rEnd Sub
”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.
-Mike Kapnisakis, Warner Bros
With your subscription - you'll gain access to our exclusive IT community of thousands of IT pros. You'll also be able to connect with highly specified Experts to get personalized solutions to your troubleshooting & research questions. It’s like crowd-sourced consulting.
We can't always guarantee that the perfect solution to your specific problem will be waiting for you. If you ask your own question - our Certified Experts will team up with you to help you get the answers you need.
Our certified Experts are CTOs, CISOs, and Technical Architects who answer questions, write articles, and produce videos on Experts Exchange. 99% of them have full time tech jobs - they volunteer their time to help other people in the technology industry learn and succeed.
We can't guarantee quick solutions - Experts Exchange isn't a help desk. We're a community of IT professionals committed to sharing knowledge. Our experts volunteer their time to help other people in the technology industry learn and succeed.