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

george4884

New Member
Joined
Mar 16, 2014
Messages
6
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:

Column AColumn BColumn CColumn D
110003458/3/201407:30WGFH2



IJLKS



KJB4HL



KJBKLB
110003468/3/201408:50FEHWJ
110003479/3/201411:24GHJHO



KSBJLK
110003489/3/201418:13DFHYK



KJLBK5



KLJBLK



KKLJ90
110003499/3/201419:30KJBFJ



SGEBE



DGGT
1100035010/3/201406:45KLNKJ
1100035110/3/201407:38JHSBN



RHTYH
1100035210/3/201408:15KJSN9



HRH53



DTHT4
1100035310/3/201417:31JGLIO



SGEBE



DFHYK

<tbody>
</tbody>

This is how I want it to be modified:

Column AColumn BColumn CColumn D
110003458/3/201407:30WGFH2



IJLKS



KJB4HL



KJBKLB



QUERY
110003468/3/201408:50FEHWJ
110003479/3/201410:24GHJHO



KSBJLK
110003489/3/201418:13DFHYK



KJLBK5



KLJBLK



KKLJ90



QUERY
110003499/3/201419:30KJBFJ



SGEBE



DGGT



QUERY
1100035010/3/201406:45KLNKJ



QUERY
1100035110/3/201407:38JHSBN



RHTYH



QUERY
1100035210/3/201408:15KJSN9



HRH53



DTHT4
1100035310/3/201417:31JGLIO



SGEBE



DFHYK



QUERY

<tbody>
</tbody>

Hope someone could help me on this...

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

Thanks!
 

C Moore

Active Member
Joined
Jan 17, 2014
Messages
431
Not sure how fast this will run, but seems to match your result.
Code:
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

New Member
Joined
Mar 16, 2014
Messages
6
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:

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

<tbody>
</tbody>


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

C Moore

Active Member
Joined
Jan 17, 2014
Messages
431
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

New Member
Joined
Mar 16, 2014
Messages
6
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.

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

george4884

New Member
Joined
Mar 16, 2014
Messages
6
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

Active Member
Joined
Jan 17, 2014
Messages
431
I haven't modified it for the one other exception, but this will add the dates.
Code:
 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

New Member
Joined
Mar 16, 2014
Messages
6
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

Active Member
Joined
Jan 17, 2014
Messages
431
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.
 

Forum statistics

Threads
1,081,615
Messages
5,360,037
Members
400,565
Latest member
Tommy O

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top