VB code to auto fill number through a date range

[redspanna]

Hi all

Can somebody please help with some VB code that will carry out following simple task...

step 1 > ask user to input start date
step 2 > ask user to input number value
step 3 > ask user to input end date
step 4 VBA will paste the number value input from step2 every 7 days from the start date input in step1 through to the end date input in step3

The following table gives the desired result when the following are input..

Step 1 > 01APR
Step 2 > 2
Step 3 > 27APR

01-Apr	2
02-Apr
03-Apr
04-Apr
05-Apr
06-Apr
07-Apr
08-Apr	2
09-Apr
10-Apr
11-Apr
12-Apr
13-Apr
14-Apr
15-Apr	2
16-Apr
17-Apr
18-Apr
19-Apr
20-Apr
21-Apr
22-Apr	2
23-Apr
24-Apr
25-Apr
26-Apr
27-Apr

hope this makes sense and thanks in advance

 

[Sahak]

Hi redspanna,​

Try this

Option Explicit
Sub User_StartDate()     'START FROM THIS CODE
  Dim strDate As String
  strDate = InputBox("Insert Start Date")
  If IsDate(strDate) Then
    strDate = Format(CDate(strDate), "dd-Mmm")
    Range("A2").Value = strDate
    Beep
    Call User_Number
  Else
    MsgBox "Invalid Date"
    strDate = InputBox("Insert Start Date ")
  End If
End Sub
Sub User_Number()
    Dim Num As Variant
    Num = InputBox("Insert Number")
    If Not IsNumeric(Num) Then
        MsgBox "Invalid Number"
        Num = InputBox("Insert Number")
        Exit Sub
    End If
    If Val(Num) <> Int(Num) Then Exit Sub
    Range("E1").Value = Num
    Beep
    Call User_EndDate
End Sub
Sub User_EndDate()
  Dim strDate As String
  strDate = InputBox("Insert End Date")
  If IsDate(strDate) Then
    strDate = Format(CDate(strDate), "dd-Mmm")
    Range("F1").Value = strDate
    Call Fill_Dates
  Else
    MsgBox "Invalid Date"
    strDate = InputBox("Insert End Date")
  End If
End Sub
Sub Fill_Dates()
    Dim EndDt As String
    EndDt = Range("F1").Value
     Range("A2").Select
    Selection.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _
        xlDay, Step:=1, Stop:=EndDt, Trend:=False
    Call Put_Number
End Sub
Sub Put_Number()
    Dim currentCell As Range
    Dim nextCell As Range
    Set currentCell = Range("A2")
    currentCell.Offset(0, 1).Value = Range("E1").Value
    Do While Not IsEmpty(currentCell)
        Set nextCell = currentCell.Offset(7)
        If nextCell <> "" Then nextCell.Offset(0, 1).Value = Range("E1").Value
        Set currentCell = nextCell
    Loop
End Sub

 

[Norie]

Try this.

Option Explicit
Sub DateSeries()
Dim dtStart As Date
Dim dtEnd As Date
Dim varNumber As Variant
Dim varResponse As Variant

    varResponse = InputBox("Please enter start date:")
    If Not IsDate(dtStart) Then
        MsgBox "Please enter a valid date!", vbCritical, "Invalid date"
        Exit Sub
    Else
        dtStart = DateValue(varResponse)
    End If
    varResponse = InputBox("Please enter end date:")
    If Not IsDate(dtEnd) Then
        MsgBox "Please enter a valid date!", vbCritical, "Invalid date"
        Exit Sub
    Else
        dtEnd = DateValue(varResponse)
    End If
    
    If dtStart >= dtEnd Then
        MsgBox "End date should occur after start date!", vbCritical, "Invalid date"
        Exit Sub
    End If
    
    varNumber = InputBox("Please enter number:")
    
    With Range("A2").Resize(dtEnd - dtStart + 1)
        .Cells(1, 1).Value = dtStart
        .Cells(1, 1).Offset(, 1).Value = varNumber
        .Cells(1, 1).Offset(, 1).Resize(7).Copy .Areas(1).Resize(((dtEnd - dtStart) \ 7 + 1) * 7).Offset(, 1)
        .DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:= _
        xlDay, Step:=1, Stop:=dtEnd, Trend:=False
    End With
    
End Sub