Inserting date

stanco

New Member
Joined
Mar 16, 2019
Messages
26
Hi, I know there are a lot of discussion on inserting static date using vba, but I need something different. i need one that would insert a dummy date whenever the next cell is empty.

to be more specific, I need a code to reflect the date of the respective surveys in the respective column whenever i input the result, but will display a dummy date when the result is blank. (the surveys are done on ad hoc basis, so some people might have done 3, but some have not even started on it).

I intend to use pivot table to count the number of the survey done over time, so i can't leave any blank in the survey date column.

NameSurvey 1 DateResultSurvey 2 DateResultSurvey Date 3Result

<tbody>
</tbody>

appreciate it if anyone can assist or suggest something for me please.
 

Some videos you may like

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,093
Office Version
365
Platform
Windows
Code:
Sub AddDummyDate()
    Dim rng As Range, Col As Long
    Set rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
    For Col = 2 To 6 Step 2
        On Error Resume Next
        rng.Offset(, Col - 1).SpecialCells(xlCellTypeBlanks) = DateSerial(1999, 12, 31)
        On Error GoTo 0
    Next Col
End Sub
BEFORE

Excel 2016 (Windows) 32 bit
A
B
C
D
E
F
G
1
NameSurvey 1 DateResultSurvey 2 DateResultSurvey Date 3Result
2
Name01
04/03/2019​
09/03/2019​
11/03/2019​
3
Name02
05/03/2019​
10/03/2019​
12/03/2019​
4
Name03
06/03/2019​
11/03/2019​
5
Name04
07/03/2019​
6
Name05
08/03/2019​
7
Name06
09/03/2019​
Sheet: Sheet2

AFTER

Excel 2016 (Windows) 32 bit
A
B
C
D
E
F
G
1
NameSurvey 1 DateResultSurvey 2 DateResultSurvey Date 3Result
2
Name01
04/03/2019​
09/03/2019​
11/03/2019​
3
Name02
05/03/2019​
10/03/2019​
12/03/2019​
4
Name03
06/03/2019​
11/03/2019​
31/12/1999
5
Name04
07/03/2019​
31/12/1999
31/12/1999
6
Name05
08/03/2019​
31/12/1999
31/12/1999
7
Name06
09/03/2019​
31/12/1999
31/12/1999
Sheet: Sheet2
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,093
Office Version
365
Platform
Windows
The above put a date in the column whenever the date is blank

Having read your post again, I think you want date put in if adjacent RESULT column is blank

Code:
Sub AddDummyDate()
    Dim rng As Range, Col As Long
    Set rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
    For Col = 2 To 6 Step 2
        On Error Resume Next
        rng.Offset(, Col).SpecialCells(xlCellTypeBlanks).Offset(, -1) = DateSerial(1999, 12, 31)
        On Error GoTo 0
    Next Col
End Sub
But this does not ensure that there is a date in every cell
 
Last edited:

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,093
Office Version
365
Platform
Windows
If you want BOTH the Date and Result to be blank before amending (eg to prevent a previously entered date being overwritten)
Code:
Sub AddDummyDate()
    Dim rng As Range, rng1 As Range, rng2 As Range, Col As Long
    Set rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
    For Col = 2 To 6 Step 2
        On Error Resume Next
        Set rng1 = rng.Offset(, Col).SpecialCells(xlCellTypeBlanks).Offset(, -1)
        Set rng2 = rng.Offset(, Col - 1).SpecialCells(xlCellTypeBlanks)
        Intersect(rng1, rng2) = DateSerial(1999, 12, 31)
        On Error GoTo 0
    Next Col
End Sub
This would not add a date if Result contains text but Date is empty
 
Last edited:

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,093
Office Version
365
Platform
Windows
Finally

You may want to add default dates automatcally whenever a new record is added in column A

Place this in SHEET module
(right-click on sheet tab \ View Code \ paste code below into code window \ {ALT}{F11} to go back to Excel)

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim offS As Long
    If Target.Row < 2 Then Exit Sub   [COLOR=#006400][I]'to ignore headers in row 1[/I][/COLOR]
    If Not Intersect(Range("A:A"), Target) Is Nothing Then
        For offS = 1 To 5 Step 2
                Target.Offset(, offS) = DateSerial(1999, 12, 31)
        Next
    End If
End Sub
 

stanco

New Member
Joined
Mar 16, 2019
Messages
26
Hi Yongle, thank you very much for the codes. I will try it out over the weekends.

On the topic of date, I do not know if this is possible, but let say i have to prepare a token to those who have done two or more surveys. but because there are thousands of rows (i know i can do a filter but i need to do this quite often and i am hoping to make it more "automatic").

Is it possible to extract the entire row from the table out to a fresh sheet whenever i input the start and end date?

taking your table for example (which i have amended slightly), my start date = 10/03/2019 and end date = 18/03/2019

The original table
ABCDEFG
1
NameSurvey 2 DateResultSurvey 3 DateResultSurvey 4 DateResult
2
Name01
04/03/2019​
123
09/03/2019​
124
11/03/2019​
125
3
Name02
05/03/2019​
130
10/03/2019​
129
12/03/2019​
128
4
Name03
06/03/2019​
107
11/03/2019​
123
31/12/1999
5
Name04
07/03/2019​
125
1/02/2019​
18/03/2019​
122
6
Name05
08/03/2019​
164
31/12/1999
31/12/1999
7
Name06
09/03/2019​
125
31/12/1999
31/12/1999

<tbody>
</tbody>
Sheet: Sheet2


<tbody>
</tbody>


Results should shows on a fresh sheet
Start Date:10/03/2019
End Date: 18/03/2019

ABCDEFG
1
NameSurvey 2 DateResultSurvey 3 DateResultSurvey 4 DateResult
2
Name01


11/03/2019​
125
3
Name02

10/03/2019​
129
12/03/2019​
128
4
Name03

11/03/2019​
123

5
Name04


18/03/2019​
122


<tbody>
</tbody>
Sheet: Sheet2


<tbody>
</tbody>
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,093
Office Version
365
Platform
Windows
I am away for several days so cannot help now.

But my immediate reaction would be to use Advanced Filter, which can cope with the filtering requirements and can filter results to another sheet
And it could easily be automated with a simple macro

Have a look at this https://www.contextures.com/xladvfilter01.html

Set up criteria range looking similar to this

Excel 2016 (Windows) 32 bit
G
H
I
J
K
L
M
N
1
Survey 2 DateSurvey 2 DateSurvey 3 DateSurvey 3 DateSurvey 4 DateSurvey 4 Date
2
From
10/03/2019​
>=10/03/2019<=18/03/2019
3
To
18/03/2019​
>=10/03/2019<=18/03/2019
4
>=10/03/2019<=18/03/2019
Sheet: Sheet1

This a totally different question from what the title suggests - probably best if you start a new thread to get the help you want.
 

Watch MrExcel Video

Forum statistics

Threads
1,100,138
Messages
5,472,743
Members
406,835
Latest member
steve43040

This Week's Hot Topics

Top