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
Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.