[URGENT] Insert row based on day/time and then add text

[george4884]

Hi All,

I'm struggling with this situation described below:

If the day/time on Column B and Column C falls outside the criteria shown below, then I need to insert a row before the next non blank cell, and insert the word "QUERY" in Column D.

Criteria:
Monday - Friday, 08:00 until 17:00
Saturday, 08:00 until 13:00
Sunday, 08:00 until 11:00

I have made a dummy data below to illustrate how my spreadsheet looks like. My original spreadsheet >5000 rows of data.

Original data before modification:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Column A[/TD]
[TD]Column B[/TD]
[TD]Column C[/TD]
[TD]Column D[/TD]
[/TR]
[TR]
[TD]11000345[/TD]
[TD]8/3/2014[/TD]
[TD]07:30[/TD]
[TD]WGFH2[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]IJLKS[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]KJB4HL
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]KJBKLB[/TD]
[/TR]
[TR]
[TD]11000346[/TD]
[TD]8/3/2014[/TD]
[TD]08:50[/TD]
[TD]FEHWJ[/TD]
[/TR]
[TR]
[TD]11000347[/TD]
[TD]9/3/2014[/TD]
[TD]11:24[/TD]
[TD]GHJHO[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]KSBJLK[/TD]
[/TR]
[TR]
[TD]11000348[/TD]
[TD]9/3/2014[/TD]
[TD]18:13[/TD]
[TD]DFHYK[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]KJLBK5
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]KLJBLK[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]KKLJ90[/TD]
[/TR]
[TR]
[TD]11000349[/TD]
[TD]9/3/2014[/TD]
[TD]19:30[/TD]
[TD]KJBFJ[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]SGEBE[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]DGGT[/TD]
[/TR]
[TR]
[TD]11000350[/TD]
[TD]10/3/2014[/TD]
[TD]06:45[/TD]
[TD]KLNKJ[/TD]
[/TR]
[TR]
[TD]11000351[/TD]
[TD]10/3/2014[/TD]
[TD]07:38[/TD]
[TD]JHSBN[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]RHTYH[/TD]
[/TR]
[TR]
[TD]11000352[/TD]
[TD]10/3/2014[/TD]
[TD]08:15[/TD]
[TD]KJSN9[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]HRH53[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]DTHT4[/TD]
[/TR]
[TR]
[TD]11000353[/TD]
[TD]10/3/2014[/TD]
[TD]17:31[/TD]
[TD]JGLIO[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]SGEBE[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]DFHYK[/TD]
[/TR]
</tbody>[/TABLE]

This is how I want it to be modified:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Column A[/TD]
[TD]Column B[/TD]
[TD]Column C[/TD]
[TD]Column D[/TD]
[/TR]
[TR]
[TD]11000345[/TD]
[TD]8/3/2014[/TD]
[TD]07:30[/TD]
[TD]WGFH2[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]IJLKS[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]KJB4HL
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]KJBKLB[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]QUERY[/TD]
[/TR]
[TR]
[TD]11000346[/TD]
[TD]8/3/2014[/TD]
[TD]08:50[/TD]
[TD]FEHWJ[/TD]
[/TR]
[TR]
[TD]11000347[/TD]
[TD]9/3/2014[/TD]
[TD]10:24[/TD]
[TD]GHJHO[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]KSBJLK[/TD]
[/TR]
[TR]
[TD]11000348[/TD]
[TD]9/3/2014[/TD]
[TD]18:13[/TD]
[TD]DFHYK[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]KJLBK5
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]KLJBLK[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]KKLJ90[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]QUERY[/TD]
[/TR]
[TR]
[TD]11000349[/TD]
[TD]9/3/2014[/TD]
[TD]19:30[/TD]
[TD]KJBFJ[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]SGEBE[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]DGGT[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]QUERY[/TD]
[/TR]
[TR]
[TD]11000350[/TD]
[TD]10/3/2014[/TD]
[TD]06:45[/TD]
[TD]KLNKJ[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]QUERY[/TD]
[/TR]
[TR]
[TD]11000351[/TD]
[TD]10/3/2014[/TD]
[TD]07:38[/TD]
[TD]JHSBN[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]RHTYH[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]QUERY[/TD]
[/TR]
[TR]
[TD]11000352[/TD]
[TD]10/3/2014[/TD]
[TD]08:15[/TD]
[TD]KJSN9[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]HRH53[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]DTHT4[/TD]
[/TR]
[TR]
[TD]11000353[/TD]
[TD]10/3/2014[/TD]
[TD]17:31[/TD]
[TD]JGLIO[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]SGEBE[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]DFHYK
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]QUERY[/TD]
[/TR]
</tbody>[/TABLE]

Hope someone could help me on this...

File format: Ms Excel 97-2003 (*.xls), Windows 7/8

Thanks!

 

[C Moore]

Not sure how fast this will run, but seems to match your result.

Sub insert_row()
    lastrow = Cells.Find(what:="*", searchdirection:=xlPrevious).Row
    num_dates = WorksheetFunction.CountA(Range(Range("B1"), Range("B" & lastrow))) 'subtract any number of headers that exist in B
    Range("B1").Select 'set to first date cell in column B
        For i = 1 To num_dates - 1
            Select Case WorksheetFunction.Weekday(ActiveCell, 2) 'pick day of week
                Case 1 To 5
                    If ActiveCell.Offset(0, 1) * 24 < 8 Or ActiveCell.Offset(0, 1) * 24 > 17 Then _
                    GoTo AddRow
                Case 6
                    If ActiveCell.Offset(0, 1) * 24 < 8 Or ActiveCell.Offset(0, 1) * 24 > 13 Then _
                    GoTo AddRow
                Case 7
                    If ActiveCell.Offset(0, 1) * 24 < 8 Or ActiveCell.Offset(0, 1) * 24 > 11 Then _
                    GoTo AddRow
           End Select
            ActiveCell.End(xlDown).Select
            GoTo Skipover
AddRow:
                ActiveCell.End(xlDown).EntireRow.Insert
                ActiveCell.End(xlDown).Offset(-1, 2).Value = "QUERY"
                ActiveCell.End(xlDown).Select
Skipover:
        Next i
    'Handle the very last date
            Select Case WorksheetFunction.Weekday(ActiveCell, 2) 'pick day of week
                Case 1 To 5
                    If ActiveCell.Offset(0, 1) * 24 < 8 Or ActiveCell.Offset(0, 1) * 24 > 17 Then _
                    GoTo AddQuery
                Case 6
                    If ActiveCell.Offset(0, 1) * 24 < 8 Or ActiveCell.Offset(0, 1) * 24 > 13 Then _
                    GoTo AddQuery
                Case 7
                    If ActiveCell.Offset(0, 1) * 24 < 8 Or ActiveCell.Offset(0, 1) * 24 > 11 Then _
                    GoTo AddQuery
           End Select
        Exit Sub
AddQuery:
    On Error GoTo AddQuery2
                ActiveCell.Offset(0, 2).End(xlDown).Offset(1, 0).Value = "QUERY"
        Exit Sub
AddQuery2:
                ActiveCell.Offset(1, 2).Value = "QUERY"
End Sub

 

[george4884]

Hi C Moore,

Appreciate your time on this. That code is certainly far different than what I imagined it would be - its just brilliantly short.

However, it returns an error when I tried to run it: Compile error: End Select without Select Case

Also, I'm sorry because I've missed to describe the following details in my first post:

1. The date is copied down until the next episode - I've copied part of my actual data below.
2. There's an exception to the criteria: I don't need to add the text "QUERY" for all episodes that has the code "KSHL7" in Column D.

Example data:

[TABLE="width: 292"]
<tbody>[TR]
[TD]11980994
[/TD]
[TD]8/3/2014
[/TD]
[TD]12:37:33
[/TD]
[TD]SZJ0QP
[/TD]
[/TR]
[TR]
[TD]11980995
[/TD]
[TD]8/3/2014
[/TD]
[TD]12:40:49
[/TD]
[TD]SZJ0
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]8/3/2014
[/TD]
[TD][/TD]
[TD]OIVV5
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]8/3/2014
[/TD]
[TD][/TD]
[TD]8EA
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]8/3/2014
[/TD]
[TD][/TD]
[TD]IJVO
[/TD]
[/TR]
[TR]
[TD]11980997
[/TD]
[TD]8/3/2014
[/TD]
[TD]12:50:15
[/TD]
[TD]SZJ0QPV
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]8/3/2014
[/TD]
[TD][/TD]
[TD]8AASD
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]8/3/2014
[/TD]
[TD][/TD]
[TD]OIVV5
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]8/3/2014
[/TD]
[TD][/TD]
[TD]8EA
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]8/3/2014
[/TD]
[TD][/TD]
[TD]IJVO
[/TD]
[/TR]
[TR]
[TD]11980998
[/TD]
[TD]8/3/2014
[/TD]
[TD]12:55:09
[/TD]
[TD]V7HV
[/TD]
[/TR]
[TR]
[TD]11980999
[/TD]
[TD]8/3/2014
[/TD]
[TD]12:56:18
[/TD]
[TD]SZJ0QPV
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]8/3/2014
[/TD]
[TD][/TD]
[TD]8ATYZ
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]8/3/2014
[/TD]
[TD][/TD]
[TD]8A8NS
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]8/3/2014
[/TD]
[TD][/TD]
[TD]8AASD
[/TD]
[/TR]
[TR]
[TD]11987600
[/TD]
[TD]8/3/2014
[/TD]
[TD]12:58:03
[/TD]
[TD]VBA18
[/TD]
[/TR]
[TR]
[TD]11987601
[/TD]
[TD]8/3/2014
[/TD]
[TD]12:59:11
[/TD]
[TD]L7HP
[/TD]
[/TR]
[TR]
[TD]11987602
[/TD]
[TD]8/3/2014
[/TD]
[TD]13:00:32
[/TD]
[TD]SZJ0
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]8/3/2014
[/TD]
[TD][/TD]
[TD]VBA18
[/TD]
[/TR]
[TR]
[TD]11987603
[/TD]
[TD]8/3/2014
[/TD]
[TD]13:10:38
[/TD]
[TD]SZJ0QPV
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]8/3/2014
[/TD]
[TD][/TD]
[TD]V7HV
[/TD]
[/TR]
[TR]
[TD]11987604
[/TD]
[TD]8/3/2014
[/TD]
[TD]13:14:25
[/TD]
[TD]SZJ0
[/TD]
[/TR]
[TR]
[TD]11987605
[/TD]
[TD]8/3/2014
[/TD]
[TD]13:02:34
[/TD]
[TD]KSHL7
[/TD]
[/TR]
[TR]
[TD]11987606
[/TD]
[TD]8/3/2014
[/TD]
[TD]13:05:49
[/TD]
[TD]KSHL7
[/TD]
[/TR]
[TR]
[TD]11987607
[/TD]
[TD]8/3/2014
[/TD]
[TD]14:44:20
[/TD]
[TD]L7HP
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]8/3/2014
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11987608
[/TD]
[TD]8/3/2014
[/TD]
[TD]14:42:42
[/TD]
[TD]SSO8SO
[/TD]
[/TR]
[TR]
[TD]11987609
[/TD]
[TD]8/3/2014
[/TD]
[TD]16:06:06
[/TD]
[TD]SZJ0
[/TD]
[/TR]
[TR]
[TD]11987610
[/TD]
[TD]8/3/2014
[/TD]
[TD]16:07:23
[/TD]
[TD]WESW
[/TD]
[/TR]
[TR]
[TD]11987611
[/TD]
[TD]8/3/2014
[/TD]
[TD]16:08:58
[/TD]
[TD]SZJ0
[/TD]
[/TR]
[TR]
[TD]11987612
[/TD]
[TD]8/3/2014
[/TD]
[TD]16:10:05
[/TD]
[TD]SZJ0
[/TD]
[/TR]
[TR]
[TD]11987613
[/TD]
[TD]8/3/2014
[/TD]
[TD]16:12:06
[/TD]
[TD]KSHL7
[/TD]
[/TR]
[TR]
[TD]11987614
[/TD]
[TD]8/3/2014
[/TD]
[TD]16:13:33
[/TD]
[TD]KSHL7
[/TD]
[/TR]
[TR]
[TD]11987615
[/TD]
[TD]8/3/2014
[/TD]
[TD]16:52:15
[/TD]
[TD]ANAW
[/TD]
[/TR]
[TR]
[TD]11987616
[/TD]
[TD]8/3/2014
[/TD]
[TD]16:53:25
[/TD]
[TD]SZJ02
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]8/3/2014
[/TD]
[TD][/TD]
[TD]IJVO
[/TD]
[/TR]
[TR]
[TD]11987617
[/TD]
[TD]8/3/2014
[/TD]
[TD]16:54:34
[/TD]
[TD]SZJ0VB
[/TD]
[/TR]
[TR]
[TD]11987618
[/TD]
[TD]8/3/2014
[/TD]
[TD]16:56:01
[/TD]
[TD]SZJ0
[/TD]
[/TR]
[TR]
[TD]11988313
[/TD]
[TD]8/3/2014
[/TD]
[TD]13:26:30
[/TD]
[TD]AMPV
[/TD]
[/TR]
[TR]
[TD]11988314
[/TD]
[TD]8/3/2014
[/TD]
[TD]13:28:02
[/TD]
[TD]SSO8SO
[/TD]
[/TR]
[TR]
[TD]11988315
[/TD]
[TD]8/3/2014
[/TD]
[TD]13:29:55
[/TD]
[TD]SSO8SO
[/TD]
[/TR]
[TR]
[TD]11988316
[/TD]
[TD]8/3/2014
[/TD]
[TD]16:51:02
[/TD]
[TD]SZJ0
[/TD]
[/TR]
[TR]
[TD]11988317
[/TD]
[TD]8/3/2014
[/TD]
[TD]16:52:20
[/TD]
[TD]ABO
[/TD]
[/TR]
[TR]
[TD]11128864
[/TD]
[TD]8/3/2014
[/TD]
[TD]15:26:28
[/TD]
[TD]KSHL7
[/TD]
[/TR]
[TR]
[TD]11128865
[/TD]
[TD]8/3/2014
[/TD]
[TD]15:25:29
[/TD]
[TD]KSHL7
[/TD]
[/TR]
[TR]
[TD]11128866
[/TD]
[TD]8/3/2014
[/TD]
[TD]15:24:30
[/TD]
[TD]KSHL7
[/TD]
[/TR]
[TR]
[TD]11128867
[/TD]
[TD]8/3/2014
[/TD]
[TD]15:23:45
[/TD]
[TD]KSHL7
[/TD]
[/TR]
</tbody>[/TABLE]


Please advise what went wrong here. Many mant thanks in advance!

 

[C Moore]

Do you want the date where QUERY is added? And can you check the error? There should be one end select for each select, and as far as I can tell there is (ie runs for me with your sample data).

 

[george4884]

Hi C Moore,

Yes, I need the date to be copied down when QUERY is added - thanks

I've checked my code and it's identical to yours. I'll explore why I'm getting compile error when running the code in my original spreadsheet. I'll check the cell formats as well.

However, when I tried your code on a fresh spreadsheet with the sample data I've provided here, I don't see the compile error now, but there is a new error: Run time error '1004': Application defined or object defined error and debug tool highlighted the following section of the code. I also noted that the last selected cell was B65536 and "QUERY" was added in cell D65535.

AddQuery2:
                ActiveCell.Offset(1, 2).Value = "QUERY" 'debug tool highlited this row

 

[george4884]

Hi C Moore,

I hope you can help me with this soon. I tried to modify the code but no success so far.

Thanks.

 

[C Moore]

I haven't modified it for the one other exception, but this will add the dates.

 Sub insert_row()
    lastrow = Cells.Find(What:="*", SearchDirection:=xlPrevious).Row
    num_dates = WorksheetFunction.CountA(Range(Range("B1"), Range("B" & lastrow))) 'subtract any number of headers that exist in B
    Range("B1").Select 'set to first date cell in column B
        For i = 1 To num_dates - 1
            Select Case WorksheetFunction.Weekday(ActiveCell, 2) 'pick day of week
                Case 1 To 5
                    If ActiveCell.Offset(0, 1) * 24 < 8 Or ActiveCell.Offset(0, 1) * 24 > 17 Then _
                    GoTo AddRow
                Case 6
                    If ActiveCell.Offset(0, 1) * 24 < 8 Or ActiveCell.Offset(0, 1) * 24 > 13 Then _
                    GoTo AddRow
                Case 7
                    If ActiveCell.Offset(0, 1) * 24 < 8 Or ActiveCell.Offset(0, 1) * 24 > 11 Then _
                    GoTo AddRow
           End Select
            ActiveCell.End(xlDown).Select
            GoTo Skipover
AddRow:
                ActiveCell.End(xlDown).EntireRow.Insert
                ActiveCell.End(xlDown).Offset(-1, 2).Value = "QUERY"
                ActiveCell.End(xlDown).Select
Skipover:
        Next i
    'Handle the very last date
            Select Case WorksheetFunction.Weekday(ActiveCell, 2) 'pick day of week
                Case 1 To 5
                    If ActiveCell.Offset(0, 1) * 24 < 8 Or ActiveCell.Offset(0, 1) * 24 > 17 Then _
                    GoTo AddQuery
                Case 6
                    If ActiveCell.Offset(0, 1) * 24 < 8 Or ActiveCell.Offset(0, 1) * 24 > 13 Then _
                    GoTo AddQuery
                Case 7
                    If ActiveCell.Offset(0, 1) * 24 < 8 Or ActiveCell.Offset(0, 1) * 24 > 11 Then _
                    GoTo AddQuery
           End Select
        GoTo AddDates
AddQuery:
    On Error GoTo AddQuery2
                ActiveCell.Offset(0, 2).End(xlDown).Offset(1, 0).Value = "QUERY"
        GoTo AddDates
AddQuery2:
                ActiveCell.Offset(1, 2).Value = "QUERY"
AddDates:
    Range(Range("B1"), Range("D1").End(xlDown).Offset(0, -2)).Select
    Dim oRng As Range
    Set oRng = Selection
        oRng.SpecialCells(xlCellTypeBlanks).Select
        oRng.FormulaR1C1 = "=R[-1]C"
        oRng.Copy
        oRng.PasteSpecial Paste:=xlValues
End Sub

 

[george4884]

I'm sorry. The code still doesn't work. I'm still getting Run time error '1004': Application defined or object defined error

I've uploaded my excel spreadsheet at this link: https://www.dropbox.com/s/wgdyntnafqhzo91/dummy1.xls

I hope someone can have look at it. I'm running out of time. Please help...

 

[george4884]

I'm sorry. The code still doesn't work. I'm still getting Run time error '1004': Application defined or object defined error

I've uploaded my excel spreadsheet at this link: https://www.dropbox.com/s/wgdyntnafqhzo91/dummy1.xls

I hope someone can have look at it. I'm running out of time. Please help...

Dear MrExcellians...

Please help me to fix my code. I still could not get it working as intended.

Thanks.

 

[C Moore]

At this point, why not do the very last entry manually, its only one entry. In that case delete everything between headers Skipover: and AddDates: including the headers.