Assumptions
- The EventLists sheet contains a list of events by day of the week and start time.
- The Master sheet contains a list of events by date.
- The Master sheet contains only one month's data.
- The Master sheet is sorted by date ASC, time ASC.
- The day of the week is divide from 05:00 to 28:59
- The Excel version is 2019.
What I want to do
For the Master sheet, if there is a time that does not exist in the EventLists sheet,
I would like to add a row and embed the target time.
I would like to make it look like the Expected Result sheet shown in the sample URL.
(Background color is not necessary.)
Sample URL
Implement
Sub appendPositionToMaster()
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim lastRowNum As Long
Dim lastRowNum2 As Long
Dim i As Integer
Dim j As Integer
Dim lastStartTime
Dim currentStartTime
Dim weekName As String
Dim startTime
Dim weekName2 As String
Dim startTime2
Set ws = Worksheets("EventLists")
Set ws2 = Worksheets("Master")
lastRowNum = ws.Range("A" & Rows.Count).End(xlUp).row
lastRowNum2 = ws2.Range("A" & Rows.Count).End(xlUp).row
For i = 2 To lastRowNum
ws.Activate
weekName = Cells(i, 1).Value
startTime = Cells(i, 3).Value
' Convert Serial To Number (0.208333333 -> "5:00" -> 500)
startTime = Val(Format(startTime, "hmm"))
For j = 2 To lastRowNum2
ws2.Activate
weekName2 = Cells(j, 2).Value
If weekName = weekName2 Then
lastStartTime = currentStartTime
currentStartTime = Cells(j, 3).Value
If lastStartTime <> currentStartTime Then
startTime2 = currentStartTime
startTime2 = Val(startTime2)
' [TEST] If current start time is not in array
arr = Array(502, 510, 606, 630, 800, 930, 1025, 1130, 1145, 1155, 1355, 1455, 1550, 1650, 1815, 1954, 2000, 2154, 2200, 2359, 2454, 2559, 2629)
result = Filter(arr, startTime)
If UBound(result) = -1 And startTime > startTime2 Then
MsgBox startTime & " " & startTime2 & " " & j
Rows(j).Insert
Exit For
End If
End If
End If
Next j
Next i
End Sub
Anybody help?
P.S.
@FaneDuru
what to match the EventLists data with Master data
I want to add a row based on two keys.
The day of the week (line A) and the start time (line C) of the event list.
If the day of the week in the event list matches the day of the week on the Master sheet,
and the start time in the event list does not exist on the Master sheet, add a row and insert the start time.
For example, on the Master sheet,
the first start time for 20220901 is 502,
| Date | Week | StartTime | Type |
|---|---|---|---|
| 20220901 | Thu | 502 | B |
| 20220901 | Thu | 502 | B |
| 20220901 | Thu | 502 | A |
| 20220901 | Thu | 502 | A |
| 20220901 | Thu | 502 | A |
| 20220901 | Thu | 502 | A |
but the Event List has an earlier start time of 500, so I want to add a row with a start time of 500 above 502.
| Date | Week | StartTime | Type |
|---|---|---|---|
| 20220901 | Thu | 500 | ADD |
| 20220901 | Thu | 502 | B |
| 20220901 | Thu | 502 | B |
| 20220901 | Thu | 502 | A |
| 20220901 | Thu | 502 | A |
| 20220901 | Thu | 502 | A |
| 20220901 | Thu | 502 | A |
Also, the Master sheet has start times of 1650 and 1815,
| Date | Week | StartTime | Type |
|---|---|---|---|
| 20220901 | Thu | 1650 | A |
| 20220901 | Thu | 1650 | A |
| 20220901 | Thu | 1815 | A |
| 20220901 | Thu | 1815 | A |
but the event list has 1753 in between, so add a row with a start time of 1753 above 1815.
| Date | Week | StartTime | Type |
|---|---|---|---|
| 20220901 | Thu | 1650 | A |
| 20220901 | Thu | 1650 | A |
| 20220901 | Thu | 1753 | ADD |
| 20220901 | Thu | 1815 | A |
| 20220901 | Thu | 1815 | A |
Also add 2734-2855 under 2629
| Date | Week | StartTime | Type |
|---|---|---|---|
| 20220901 | Thu | 2629 | A |
| 20220901 | Thu | 2734 | ADD |
| 20220901 | Thu | 2737 | ADD |
| 20220901 | Thu | 2825 | ADD |
| 20220901 | Thu | 2855 | ADD |
I want this to be inserted in an iterative process for all dates on the Master sheet,
and eventually the rows will be added as on the Master(Expected) sheet.
It would be too much work to write everything out, so the Master(Expected) sheet only contains one day.
Did I get my point across to you to some extent? I am sorry that I am not good at English and do not understand your detailed intention.
CodePudding user response：
I wrote the following code. It works for the given example data. I am not 100% sure that I understand your question but if you could give me some advice on what you wanted more, I can update it accordingly.
Sub AddMissingStartTime()
Dim wsMaster As Worksheet
Dim wsLists As Worksheet
Dim lastrowMaster As Long
Dim lastrowLists As Long
Dim key0 As String
Dim key1 As String
Dim d0 As Date
Dim d1 As Date
Dim t0 As Date
Dim t1 As Date
Dim t0str As String
Dim t1str As String
Dim i As Long
Dim rngInsert As Range
Set wsMaster = Worksheets("Master")
Set wsLists = Worksheets("EventList")
With wsMaster
lastrowMaster = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lastrowMaster
key0 = .Cells(i, "A").Value
d0 = .Cells(i, "A").Value
t0 = .Cells(i, "C").Value
With wsLists
lastrowLists = .Cells(Rows.Count, "A").End(xlUp).Row
For j = 2 To lastrowLists
key1 = .Cells(j, "A").Value
d1 = .Cells(j, "A").Value
t1 = .Cells(j, "C").Value
If key0 = key1 Then
t0str = Format(t0, "HH:mm")
t1str = Format(t1, "HH:mm")
If t0str <> t1str Then
If t0str < t1str Then
Set rngInsert = .Range("C" & j)
rngInsert.EntireRow.Insert
.Cells(j, "C") = t0
.Cells(j, "D") = "ADD"
End If
End If
End If
Next
End With
Next
End With
End Sub
CodePudding user response：
Please test the next solution and send some feedback.
It uses a dictionary to firstly extract the unique StartTime values in the necessary format and then keep the rows number to be inserted for each case. The code should be fast enough, most of processing being done in memory, using arrays. I commented all code lines which could not be easily understood:
Sub appendPositionToMaster()
Dim wb As Workbook, ws As Worksheet, wsM As Worksheet, lastR As Long, lastRM As Long
Dim arrT, arrDic, arrM, mtch, i As Long, j As Long, k As Long, L As Long, dict As Object
Dim rngMT As Range, arrRows, rngIns As Range, boolFirst As Boolean, boolFirstLine As Boolean
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("EventLists")
Set wsM = Worksheets("Master")
lastR = ws.Range("A" & ws.rows.count).End(xlUp).row
lastRM = wsM.Range("A" & wsM.rows.count).End(xlUp).row
arrM = wsM.Range("A2:C" & lastRM).Value2 'place the rangge in an array for faster iteration
arrT = ws.Range("C2:C" & lastR).Value2 'the Time column array (from EventLists)
'place UNIQUE time records from EventLists in dictionary, as keys:
Set dict = CreateObject("Scripting.Dictionary") 'create the dictionary
For i = 1 To UBound(arrT)
dict(val(Replace(arrT(i, 1), ":", ""))) = 1
Next i
arrDic = dict.Keys: dict.RemoveAll 'place the dictionary keys in an array and empty the dictionary to reuse it
BubbleSort arrDic 'sort the array Ascending
Debug.Print Join(arrDic, "|"): 'just to visually see in Immediate Window the array of UNIQUE reference time values
Set rngMT = wsM.Range("C2:C" & lastRM) 'The range of StartTime from Master
For i = 0 To UBound(arrDic) 'iterate between the UNIQUE time values from EventLists
mtch = Application.match(arrDic(i), rngMT, 0) 'check if the time value exists in Master C:C column
If IsError(mtch) Then 'if it does not exist:
For j = 1 To UBound(arrM) 'iterate between arrM elements:
If arrM(j, 3) > arrDic(i) Then 'if iterated time value is greater than the time value from the array:
If j = 1 Then 'only if first array row is greater than reference time:
dict(arrDic(i)) = dict(arrDic(i)) & "|" & j 1 'create the dictionary key as time value and item as row number
boolFirstLine = True 'variable used to copy format for the second row (as header, after inserting a row)
End If
For k = 2 To UBound(arrM) 'iterating again between the arrM items:
If arrM(k, 3) = arrM(j, 3) And arrM(k, 3) <> arrM(k - 1, 3) Then 'find the case of the reference value first occurrence
dict(arrDic(i)) = dict(arrDic(i)) & "|" & k 1 'add the row number to the dictionary item
End If
Next k
arrRows = Split(dict(arrDic(i)), "|") 'place the dictionary current processed item in an array
arrRows(0) = "$$##": arrRows = filter(arrRows, "$$##", False) 'eliminate the first (empty) array element
Set rngIns = wsM.Range("A" & Join(arrRows, ",A")) 'build the range of rows numbers to be inserted at once
rngIns.EntireRow.Insert 'insert all the necessary rows per reference value, at once
If boolFirstLine Then 'in case of an insertion of the second row:
boolFirstLine = False 'reinitialize the boolean variable to work only once
wsM.Range("A3:H3").Copy
'copy the format of the third range
wsM.Range("A2").PasteSpecial xlPasteFormats 'and paste it in the second row
End If
lastRM = wsM.Range("A" & wsM.rows.count).End(xlUp).row 'recalculate the last row after rows insertion
arrM = wsM.Range("A2:D" & lastRM).Value2
'place the necessary range in an array, for faster processing
Set rngMT = wsM.Range("C2:C" & lastRM) 'reset the reference range
For L = 1 To UBound(arrM) 'iterate between the array rows, to find the empty ones:
If arrM(L, 1) = "" Then 'if the row is empty:
If Not boolFirst Then 'first time (second row) the necessary data are copied from below
arrM(L, 1) = CStr(arrM(L 1, 1)): arrM(L, 2) = arrM(L 1, 2)
arrM(L, 3) = arrDic(i): arrM(L, 4) = "Add"
boolFirst = True 'reinitialize the boolean variable
Else 'for the next times the necessary data are copied from above
arrM(L, 1) = CStr(arrM(L 1, 1)): arrM(L, 2) = arrM(L 1, 2)
arrM(L, 3) = arrDic(i): arrM(L, 4) = "Add"
End If
End If
Next L
'drop the content of the processed array at once:
wsM.Range("A2").Resize(UBound(arrM), UBound(arrM, 2)) = arrM
Exit For 'exit the loop
End If
Next j
End If
Next i
MsgBox "Ready..."
End Sub
Private Sub BubbleSort(arr) 'function to sort a 1D array
Dim i As Long, j As Long, temp
For i = LBound(arr) To UBound(arr) - 1
For j = i 1 To UBound(arr)
If arr(i) > arr(j) Then
temp = arr(i): arr(i) = arr(j)
arr(j) = temp
End If
Next j
Next i
End Sub