qwe001
August 25, 2022
50 views
3 votes
3 Answers

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

https://docs.google.com/spreadsheets/d/e/2PACX-1vTJAr87dZ_92NxxR-eS5gUrKW9dmb5liaw4748eb730EHGrotcQTBQS9LDcBkZKauyWKeYfFuUo3Abk/pubhtml

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.

P.S. (again)

@FaneDuru

Thank you for your reply.
I was on deadline for another job yesterday.

I was going to send you the file today.
Thank you for working on it first.

Your VBA source code is very close to what I want to do,
but not quite finished yet.

The VBA source code you provided is very difficult to me.
I can’t figure out what changes I need to make to make it the way I want it.

I ran the test code and it seems to be ignoring the day of the week values and simply taking the start time values from the EventLists sheet as a unique array and inserting it into the Master sheet.

I would like to use the day of the week as a key and insert a row for each day of the week

and for each start time that does not exist on the Master sheet.

I’m not sure how to write this in VBA.

I will write what I want to do in PHP source code.

The code below is an image, it will not actually work in a PHP environment.

function getStartTimesGroupByWeekNameFromEventLists()
{
  $arr = array(
    "Mon" => array("500","502","510","606","630","800","930","1025","1130","1145","1155","1355","1455","1550","1650","1753","1815","1900","2000","2100","2154","2200","2300","2359","2454","2559","2739","2742","2842")
    "Tue" => array("500","502","510","606","630","800","930","1025","1130","1145","1155","1355","1455","1550","1650","1753","1815","1900","1954","2000","2100","2154","2200","2300","2359","2454","2524","2529","2559","2719")
    "Wed" => array("500","502","510","606","630","800","930","1025","1130","1145","1155","1355","1455","1550","1650","1753","1815","1900","1954","2000","2100","2154","2200","2300","2359","2454","2524","2529","2535","2637","2704","2707","2737","2837")
    "Thu" => array("500","502","510","606","630","800","930","1025","1130","1145","1155","1355","1455","1550","1650","1753","1815","1900","1954","2000","2100","2154","2200","2300","2359","2454","2559","2629","2734","2737","2825","2855")
    "Fri" => array("500","502","510","606","630","800","930","1025","1125","1130","1145","1155","1355","1455","1550","1650","1753","1815","1900","1956","2054","2100","2254","2300","2330","2430","2459","2505","2558","2604","2631","2640","2643","2815","2845")
    "Sat" => array("515","530","628","800","925","1125","1135","1145","1155","1254","1500","1600","1700","1730","1800","1830","1900","1956","2054","2100","2154","2200","2254","2300","2330","2355","2455","2458","2528","2558","2628","2653","2657","2700","2730","2835")
    "Sun" => array("505","535","600","615","630","700","730","955","1025","1055","1125","1135","1140","1235","1330","1500","1630","1730","1800","1855","1900","1958","2054","2100","2154","2200","2230","2325","2355","2455","2525","2532","2537","2639","2719","2722","2726","2756","2856")
  );
  return $arr;
}

function getUniqueStartTimesFromMaster($mstRows)
{
  //$startTimes = array_column($mstRows, "startTimes");
  //$uniqueStartTimes = array_unique($startTimes);
  //return $uniqueStartTimes;

  // [example] 20220901 rows (row 2 To 95)
  $startTimes = array("502","502","502","502","502","502","510","510","606","606","630","630","630","630","800","800","930","930","1025","1025","1025","1025","1025","1025","1025","1025","1130","1130","1130","1130","1145","1145","1155","1155","1155","1155","1155","1155","1155","1155","1355","1355","1355","1355","1455","1455","1455","1455","1550","1550","1550","1550","1550","1550","1550","1550","1650","1650","1650","1650","1815","1815","1815","1815","1954","1954","2000","2000","2154","2154","2200","2200","2359","2359","2454","2454","2454","2454","2454","2454","2559","2559","2559","2559","2629","2629","2629","2629","2629","2629","2629","2629","2629","2629");
  $uniqueStartTimes = ("502","510","606","630","800","930","1025","1130","1145","1155","1355","1455","1550","1650","1815","1954","2000","2154","2200","2359","2454","2559","2629");
  return $uniqueStartTimes;
}

function getMasterRows()
{
  $arr = array(
    0    => array("Row" => 2,    "Date" => "20220901", "Week" => "Thu", "StartTime" => "502",  "Type" => "B"),
    1    => array("Row" => 3,    "Date" => "20220901", "Week" => "Thu", "StartTime" => "502",  "Type" => "B"),
    2    => array("Row" => 4,    "Date" => "20220901", "Week" => "Thu", "StartTime" => "502",  "Type" => "A"),
    ...
    96   => array("Row" => 94,   "Date" => "20220901", "Week" => "Thu", "StartTime" => "2629", "Type" => "A"),
    97   => array("Row" => 95,   "Date" => "20220901", "Week" => "Thu", "StartTime" => "2629", "Type" => "A"),
    98   => array("Row" => 96,   "Date" => "20220902", "Week" => "Fri", "StartTime" => "502",  "Type" => "B"),
    99   => array("Row" => 97,   "Date" => "20220902", "Week" => "Fri", "StartTime" => "502",  "Type" => "B"),
    ...
    2594 => array("Row" => 2596, "Date" => "20220930", "Week" => "Fri", "StartTime" => "2604", "Type" => "A"),
    2595 => array("Row" => 2597, "Date" => "20220930", "Week" => "Fri", "StartTime" => "2631", "Type" => "B"),
    2596 => array("Row" => 2598, "Date" => "20220930", "Week" => "Fri", "StartTime" => "2631", "Type" => "B"),
  );
  return $arr;
}

function getRowsGroupByDatesFromMaster()
{
  $mstRows = getMasterRows();
  $arr = array(
    "20220901" => array(
      0 => array("Row" => 2, "Date" => "20220901", "Week" => "Thu", "StartTime" => "502", "Type" => "B"),
      1 => array("Row" => 3, "Date" => "20220901", "Week" => "Thu", "StartTime" => "502", "Type" => "B"),
      ...
      96 => array("Row" => 94, "Date" => "20220901", "Week" => "Thu", "StartTime" => "2629", "Type" => "A"),
      97 => array("Row" => 95, "Date" => "20220901", "Week" => "Thu", "StartTime" => "2629", "Type" => "A"),
    ),
    "20220902" => array(
      0  => array("Row" => 96, "Date" => "20220902", "Week" => "Fri", "StartTime" => "502", "Type" => "B"),
      1  => array("Row" => 97, "Date" => "20220902", "Week" => "Fri", "StartTime" => "502", "Type" => "B"),
      ...
      85 => array("Row" => 181, "Date" => "20220902", "Week" => "Fri", "StartTime" => "2631", "Type" => "B"),
      86 => array("Row" => 182, "Date" => "20220902", "Week" => "Fri", "StartTime" => "2631", "Type" => "B"),
    ),
    ...
    "20220930" => array(
      0  => array("Row" => 2512, "Date" => "20220930", "Week" => "Fri", "StartTime" => "502", "Type" => "B"),
      1  => array("Row" => 2513, "Date" => "20220930", "Week" => "Fri", "StartTime" => "502", "Type" => "B"),
      ...
      85 => array("Row" => 2597, "Date" => "20220930", "Week" => "Fri", "StartTime" => "2631", "Type" => "B"),
      86 => array("Row" => 2598, "Date" => "20220930", "Week" => "Fri", "StartTime" => "2631", "Type" => "B"),
    )
  );
  return $arr;
}

function getMergedMasterRows()
{
  // I didn't real count So Row number and index is wrong maybe
  $arr = array(
    0 => array("Row" => 2, "Date" => "20220901", "Week" => "Thu", "StartTime" => "500", "Type" => "ADD"),
    1 => array("Row" => 3, "Date" => "20220901", "Week" => "Thu", "StartTime" => "502", "Type" => "B"),
    2 => array("Row" => 4, "Date" => "20220901", "Week" => "Thu", "StartTime" => "502", "Type" => "B"),
    ...
    59 => array("Row" => 61, "Date" => "20220901", "Week" => "Thu", "StartTime" => "1650", "Type" => "A"),
    60 => array("Row" => 62, "Date" => "20220901", "Week" => "Thu", "StartTime" => "1650", "Type" => "A"),
    61 => array("Row" => 63, "Date" => "20220901", "Week" => "Thu", "StartTime" => "1753", "Type" => "ADD"),
    62 => array("Row" => 64, "Date" => "20220901", "Week" => "Thu", "StartTime" => "1815", "Type" => "A"),
    63 => array("Row" => 65, "Date" => "20220901", "Week" => "Thu", "StartTime" => "1815", "Type" => "A"),
    64 => array("Row" => 66, "Date" => "20220901", "Week" => "Thu", "StartTime" => "1815", "Type" => "A"),
    65 => array("Row" => 67, "Date" => "20220901", "Week" => "Thu", "StartTime" => "1815", "Type" => "A"),
    66 => array("Row" => 68, "Date" => "20220901", "Week" => "Thu", "StartTime" => "1900", "Type" => "ADD"),
    67 => array("Row" => 69, "Date" => "20220901", "Week" => "Thu", "StartTime" => "1954", "Type" => "B"),
    68 => array("Row" => 70, "Date" => "20220901", "Week" => "Thu", "StartTime" => "1954", "Type" => "B"),
    ...
    100 => array("Row" => 98, "Date" => "20220901", "Week" => "Thu", "StartTime" => "2629", "Type" => "A"),
    101 => array("Row" => 99, "Date" => "20220901", "Week" => "Thu", "StartTime" => "2734", "Type" => "ADD"),
    102 => array("Row" => 100, "Date" => "20220901", "Week" => "Thu", "StartTime" => "2737", "Type" => "ADD"),
    103 => array("Row" => 101, "Date" => "20220901", "Week" => "Thu", "StartTime" => "2825", "Type" => "ADD"),
    104 => array("Row" => 102, "Date" => "20220901", "Week" => "Thu", "StartTime" => "2855", "Type" => "ADD"),
    105 => array("Row" => 103, "Date" => "20220902", "Week" => "Fri", "StartTime" => "500", "Type" => "ADD"),
    106 => array("Row" => 104, "Date" => "20220902", "Week" => "Fri", "StartTime" => "502", "Type" => "B"),
    107 => array("Row" => 105, "Date" => "20220902", "Week" => "Fri", "StartTime" => "502", "Type" => "B"),
    ...
    2795 => array("Row" => 2797, "Date" => "20220930", "Week" => "Fri", "StartTime" => "2631", "Type" => "B"),
    2796 => array("Row" => 2798, "Date" => "20220930", "Week" => "Fri", "StartTime" => "2631", "Type" => "B"),
    2797 => array("Row" => 2799, "Date" => "20220930", "Week" => "Fri", "StartTime" => "2640", "Type" => "ADD"),
    2798 => array("Row" => 2800, "Date" => "20220930", "Week" => "Fri", "StartTime" => "2643", "Type" => "ADD"),
    2799 => array("Row" => 2801, "Date" => "20220930", "Week" => "Fri", "StartTime" => "2815", "Type" => "ADD"),
    2800 => array("Row" => 2802, "Date" => "20220930", "Week" => "Fri", "StartTime" => "2845", "Type" => "ADD"),
  );
  return $arr;
}

$mstRowsByDates = getRowsGroupByDatesFromMaster();
$evtStartTimeGroups = getStartTimesGroupByWeekNameFromEventLists();

$newRows = array();
foreach($mstRowsByDates as $mstDate => $mstRows){
  $mstRowWeekName = $mstRows[0]["Week"]; // e.g. "Thu"

  $evtStartTimes = getStartTimesByWeekNameFromEventLists($mstRowWeekName); // e.g. array("500","502","510","606","630","800","930","1025","1130","1145","1155","1355","1455","1550","1650","1753","1815","1900","1954","2000","2100","2154","2200","2300","2359","2454","2559","2629","2734","2737","2825","2855");
  $mstStartTimes = getUniqueStartTimesFromMaster($mstRows); // e.g. array("502","510","606","630","800","930","1025","1130","1145","1155","1355","1455","1550","1650","1815","1954","2000","2154","2200","2359","2454","2559","2629");

  $rowNum = 0;
  foreach($mstRows as $mstRow){
    // if current start time is not in event lists start times each days
    // like Thursday 500, 1753, 1900, 2100, 2300, 2734, 2737, 2825, 2855
    if(in_array($mstRow["StartTime"], $evtStartTimes) === false){
      $newRow = array(
        "Row" => $rowNum,
        "Date" => $mstRow["Date"],
        "Week" => $mstRow["Week"],
        "StartTime" => $mstRow["StartTime"],
        "Type" => "ADD"
      );

      $newRows[] = $newRow;
    }

    $rowNum++;
  }
}

$newRows = getMergedMasterRows();

foreach($newRows as $newRow){
  $row = $newRow["Row"];
  Rows($row).Insert
  Cells($row, 1).Value = $newRow["Date"]
  Cells($row, 2).Value = $newRow["Week"]
  Cells($row, 3).Value = $newRow["StartTime"]
  Cells($row, 4).Value = $newRow["Type"]
}

I hope this code conveys to you what I want to do…
Sorry for the poor explanation.

P.S (again 2)

@FaneDuru

Thank you for your quick reply, I tried the new code you posted.
It did not work as I expected.

My test procedure was as follows:

copy the Master sheet and rename it to Master_copy sheet
copy the MasterOrig sheet and rename it to Master sheet
Paste the sample VBA code and execute the appendPositionToMaster procedure.
confirm that there is no difference between the Master_copy sheet and the Master sheet after the dialog is completed.

I have now confirmed that the code you presented works fine in my environment.

What is not the expected result,
For example, row 9 and row 12-15.
20220901 Thu 505 Add and 515,530,535,600 are in there.

If you look at the list of Thursday start times on the EventLists sheet, you’ll see that there are no times such as 5:05 or 5:15 in there anywhere.

The missing times on the Master sheet what I wanted to insert
It’s like 5:00 and 17:53 in Thursday,
which are painted with a yellow background on the EventLists sheet.

So it is correct that 20220901 Thu 500 Add is inserted on row 2 or 20220901 Thu 1753 Add on line 73, but
It is incorrect that it is in other places.

I have sent you what I expect to see in the file.
I checked on the records from 9/1 to 9/4.

You are my only hope now…
Hopefully I will be able to give you something in return.
Could you do me a favor?

Tags: excel vba

Answers

Chosen as BEST ANSWER

By referring to your answers, I have solved this problem.

Instead of overwriting the Master sheet,

I decided to output to a separate sheet called Output sheet.

Option Explicit

'
' Masterシートをベースにして、Outputシートを作成する
' Masterシートに存在せず、EventListsシートに存在する開始時刻を行追加する
'
Public Sub AddPositionToOutput()
  Dim ws As Worksheet         'EventLists
  Dim ws2 As Worksheet        'Master
  Dim ws3 As Worksheet        'Output
  Dim lastRowNum As Long      'EventLists 最終行
  Dim lastRowNum2 As Long     'Master 最終行
  Dim weekName As String      '曜日 (EventLists)
  Dim prevWeekName As String  '前回曜日 (EventLists)
  Dim startTime As Variant    '開始時刻[h:mm] (EventLists)
  Dim startTimeL As Long      '開始時刻[hmm] (EventLists)
  Dim startTimeL2 As Long     '開始時刻[hmm] (Master)
  Dim masterDate As Long      '日付 (Master)
  Dim prevMasterDate As Long  '前回日付 (Master)
  Dim weekName2 As String     '曜日 (Master)
  Dim key As Variant
  Dim wrow As Long            '行番号 (EventLists)
  Dim wrow2 As Long           '行番号 (Master)
  Dim wrow3 As Long           '行番号 (Output)
  Dim startRowDic As Object   '開始行番号 (曜日単位)
  Dim endRowDic As Object     '終了行番号 (曜日単位)
  Dim startRow As Long        '開始行番号 (EventLists)
  Dim endRow As Long          '終了行番号 (EventLists)
  Dim currentRow As Long      '処理中行番号 (EventLists)

  Set startRowDic = CreateObject("Scripting.Dictionary")
  Set endRowDic = CreateObject("Scripting.Dictionary")
  Set ws  = Worksheets("EventLists")
  Set ws2 = Worksheets("Master")
  Set ws3 = Worksheets("Output")

  ' A列の最終行番号を取得
  lastRowNum = ws.Range("A" & Rows.Count).End(xlUp).Row
  lastRowNum2 = ws2.Range("A" & Rows.Count).End(xlUp).Row

  ' EventListsシート 行単位でループ
  prevWeekName = ""

  For wrow = 2 To lastRowNum
    ' L列(fix_week_name) の値を取得
    weekName = ws.Cells(wrow, "L").Value
    ' M列(fix_start_time) の値を取得
    startTime = ws.Cells(wrow, "M").Value

    ' M列(fix_start_time) の値をセミコロンなしの数値に変換する(0.208333333 -> "5:00" -> 500)
    If startTime > 1 Then
      ' 24時00分を過ぎる時間の時
      startTimeL = Val(Format(startTime - 1, "hmm")) + 2400
    Else
      startTimeL = Val(Format(startTime, "hmm"))
    End If

    '曜日変わり時に開始行番号を設定
    If weekName <> prevWeekName Then
      startRowDic(weekName) = wrow
    End If

    '終了行番号を設定
    endRowDic(weekName) = wrow

    '開始時刻 (数値)を設定
    ws.Cells(wrow, "Q").Value = startTimeL

    '前回曜日を保存
    prevWeekName = weekName
  Next

  'Outputシートクリア,見出し設定
  ws3.Cells.ClearContents

  wrow3 = 1
  wrow2 = 1

  Call putMaster(ws2, wrow2, ws3, wrow3)   'Master1行出力

  ' Masterシート 行単位でループ
  prevMasterDate = 0
  endRow = -1
  currentRow = 0

  For wrow2 = 2 To lastRowNum2
    ' A列の日付を取得
    masterDate = ws2.Cells(wrow2, "A").Value
    ' B列(曜日) の値を取得
    weekName2 = ws2.Cells(wrow2, "B").Value
    ' C列(開始時刻) の値を取得
    startTimeL2 = ws2.Cells(wrow2, "C").Value

    '日付変更時の処理
    If prevMasterDate <> masterDate Then
      '残っているEventLists行を出力する
      Call flushEventLists(prevMasterDate, ws, currentRow, endRow, ws3, wrow3)

      startRow = startRowDic(weekName2)
      endRow = endRowDic(weekName2)
      currentRow = startRow
    End If

    'EventListsの当日分が未処理ならEventListsを処理
    If currentRow <= endRow Then
      startTimeL = ws.Cells(currentRow, "Q").Value

      'Masterの時刻>EventListsの時刻であるEventListsを全て出力
      If startTimeL2 >= startTimeL Then
        Call putPastEventLists(masterDate, startTimeL2, ws, currentRow, endRow, ws3, wrow3)
      End If
    End If

    'Master1行出力
    Call putMaster(ws2, wrow2, ws3, wrow3)

    '前回日付を保存
    prevMasterDate = masterDate
  Next

  '残っているEventLists行を出力する
  Call flushEventLists(prevMasterDate, ws, currentRow, endRow, ws3, wrow3)
  MsgBox ("処理が完了しました。次のステップに進んでください")
End Sub

'
' Master 1行出力
'
Private Sub putMaster(ws2 As Worksheet, wrow2 As Long, ws3 As Worksheet, wrow3)
  ws3.Range("A" & wrow3).Resize(, 8).Value = ws2.Range("A" & wrow2).Resize(, 8).Value   'A～H
  wrow3 = wrow3 + 1
End Sub

'
' 残EventLists 出力
'
Private Sub flushEventLists(ByVal msdate As Long, ws As Worksheet, currentRow As Long, endRow As Long, ws3 As Worksheet, wrow3 As Long)
  Dim wrow As Long
  For wrow = currentRow To endRow
    Call putEventLists(msdate, ws, wrow, ws3, wrow3)   '1行出力
  Next
End Sub

'
' Master時刻より小さい時刻のEventListsを出力
' MasterとEventListsの時刻が同じ場合は出力しない
'
Private Sub putPastEventLists(ByVal msdate As Long, ByVal mstime As Long, ws As Worksheet, currentRow As Long, endRow As Long, ws3 As Worksheet, wrow3 As Long)
  Dim stTime As Long
  Do
    If currentRow > endRow Then Exit Do
    stTime = ws.Cells(currentRow, "Q").Value
    If mstime < stTime Then Exit Do
    If mstime > stTime Then
      Call putEventLists(msdate, ws, currentRow, ws3, wrow3)   '1行出力
    End If
    currentRow = currentRow + 1
  Loop
End Sub

'
' EventLists 1行出力
'
Private Sub putEventLists(ByVal msdate As Long, ws As Worksheet, ByVal wrow As Long, ws3 As Worksheet, wrow3 As Long)
  ws3.Cells(wrow3, "A").Value = msdate                     '日付
  ws3.Cells(wrow3, "B").Value = ws.Cells(wrow, "L").Value  '曜日
  ws3.Cells(wrow3, "C").Value = ws.Cells(wrow, "Q").Value  '時刻
  ws3.Cells(wrow3, "D").Value = "ADD"                      '種別
  ws3.Range("E" & wrow3).Resize(, 4).Value = ws.Range("F" & wrow).Resize(, 4).Value
  wrow3 = wrow3 + 1
End Sub

Thanks to your answers, I was able to meet the deadline.

Thank you from the bottom of my heart.

(Edit)

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 &lt;&gt; t1str Then
                            If t0str &lt; t1str Then
                                Set rngInsert = .Range("C" &amp; 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

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")
 
 'search for "Master(Expected)" sheet existence and delete it if exists:
 For Each wsM In wb.Worksheets
     If wsM.name = "Master(Expected)" Then
        Application.DisplayAlerts = False   'to not ask for deletion confirmation
            wsM.Delete: Exit For            'delete  "Master(Expected)"  if it exists
        Application.DisplayAlerts = True
     End If
 Next wsM
 
 'A little optimization to make the code faster:
 Application.ScreenUpdating = False: Application.EnableEvents = False: Application.Calculation = xlCalculationManual
 
  On Error GoTo SafeEnding 'reset optimization in case of an error...
  wb.Worksheets("Master").Copy Before:=wb.Worksheets("Master") 'copy "Master" sheet before itself.

   ActiveSheet.name = "Master(Expected)"
   Set wsM = wb.Worksheets("Master(Expected)")

  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..."
SafeEnding:
  Application.ScreenUpdating = True: Application.EnableEvents = True: Application.Calculation = xlCalculationAutomatic
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

Please signup or login to give your own answer.

Click here to cancel reply.

How to fill missing rows using the day of the week and time as keys in VBA? – PHP Versions

Assumptions

What I want to do

Sample URL

Implement

P.S. (again)

P.S (again 2)

Answers