VBA Auto Fill Table with all the dates within a date range with inputed data.

[Nathan95]

Hey All,

Im pretty new too VBA so I have no clue on how to go about in doing this, But what Im looking to do is work on a leave tracker, where someone can input the start and end date range for the leave as well as what the leave type is and their Employee number (P Number). Then when they click the "Input Leave" Button I want it to auto fill in a table with each date within that date range to have a seperate row with the same Leave type and employee number that was entered.

Any help would be appreciated

 

[Nathan95]

Here is a screen shot of what it looks like

 

[Peter_SSs]

Here is a screen shot of what it looks like

No screen shot supplied. However, XL2BB would be better as helpers can then copy your sample data and layout for testing without having to manually re-type everything.

 

[Nathan95]

No screen shot supplied. However, XL2BB would be better as helpers can then copy your sample data and layout for testing without having to manually re-type everything.

 

[Nathan95]

No screen shot supplied. However, XL2BB would be better as helpers can then copy your sample data and layout for testing without having to manually re-type everything.

Unfortunately as im working off my work laptop, it does not allow for add ins. but i have just resent the screen shot.

 

[Nathan95]

So I have this so far, which will input all the individual dates within the date range into column D, Now i need to be able to paste the P number and leave type next to all the dates within that range

Sub GenerateDates()

Dim FirstDate As Date
Dim LastDate As Date
Dim NextDate As Date

FirstDate = Range("L10").Value
LastDate = Range("P10").Value

NextDate = FirstDate
Range("D" & Rows.Count).End(xlUp).Offset(1).Select
Do Until NextDate > LastDate

ActiveCell.Value = NextDate
ActiveCell.Offset(1, 0).Select
NextDate = NextDate + 1

Loop

End Sub

 

[Peter_SSs]

There is a mis-match between your post #6 code and your post #4 image regarding what cells hold the input values. In the code below I have used the post #4 image cells but you can easily adjust if needed.

This suggested code checks that all 4 entry cells have data before proceeding. I have assumed that you have data validation in the Date input cells to ensure dates are actually entered.
This code also puts all the dates in at once rather that one-at-a-time.
Give it a try with a copy of your workbook.

Sub Enter_Data()
  Dim FirstDate As Date, LastDate As Date
  Dim rBlanks As Range
  
  On Error Resume Next
  Set rBlanks = Range("K7,M7,K9,N9").SpecialCells(xlBlanks)
  On Error GoTo 0
  If rBlanks Is Nothing Then
    FirstDate = Range("K7").Value
    LastDate = Range("N7").Value
    With Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(LastDate - FirstDate + 1)
      .Value = Evaluate("Row(" & CLng(FirstDate) & ":" & CLng(LastDate) & ")")
      .NumberFormat = "dd-mmm-yy"
      .Offset(, 1).Value = Range("N9").Value
      .Offset(, -2).Value = Range("K9").Value
    End With
  Else
    MsgBox "Data missing"
  End If
End Sub

 

[Nathan95]

There is a mis-match between your post #6 code and your post #4 image regarding what cells hold the input values. In the code below I have used the post #4 image cells but you can easily adjust if needed.

This suggested code checks that all 4 entry cells have data before proceeding. I have assumed that you have data validation in the Date input cells to ensure dates are actually entered.
This code also puts all the dates in at once rather that one-at-a-time.
Give it a try with a copy of your workbook.

Sub Enter_Data()
  Dim FirstDate As Date, LastDate As Date
  Dim rBlanks As Range
 
  On Error Resume Next
  Set rBlanks = Range("K7,M7,K9,N9").SpecialCells(xlBlanks)
  On Error GoTo 0
  If rBlanks Is Nothing Then
    FirstDate = Range("K7").Value
    LastDate = Range("N7").Value
    With Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(LastDate - FirstDate + 1)
      .Value = Evaluate("Row(" & CLng(FirstDate) & ":" & CLng(LastDate) & ")")
      .NumberFormat = "dd-mmm-yy"
      .Offset(, 1).Value = Range("N9").Value
      .Offset(, -2).Value = Range("K9").Value
    End With
  Else
    MsgBox "Data missing"
  End If
End Sub

Thank You so much that worked :D

 

[Nathan95]

Sorry

There is a mis-match between your post #6 code and your post #4 image regarding what cells hold the input values. In the code below I have used the post #4 image cells but you can easily adjust if needed.

This suggested code checks that all 4 entry cells have data before proceeding. I have assumed that you have data validation in the Date input cells to ensure dates are actually entered.
This code also puts all the dates in at once rather that one-at-a-time.
Give it a try with a copy of your workbook.

Sub Enter_Data()
  Dim FirstDate As Date, LastDate As Date
  Dim rBlanks As Range
 
  On Error Resume Next
  Set rBlanks = Range("K7,M7,K9,N9").SpecialCells(xlBlanks)
  On Error GoTo 0
  If rBlanks Is Nothing Then
    FirstDate = Range("K7").Value
    LastDate = Range("N7").Value
    With Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(LastDate - FirstDate + 1)
      .Value = Evaluate("Row(" & CLng(FirstDate) & ":" & CLng(LastDate) & ")")
      .NumberFormat = "dd-mmm-yy"
      .Offset(, 1).Value = Range("N9").Value
      .Offset(, -2).Value = Range("K9").Value
    End With
  Else
    MsgBox "Data missing"
  End If
End Sub

Sorry just another question, If I wanted to combine the PNumber and date and then paste it into the ID Column, how would i go about doing that? As if I add a formula on the ID column for each row it tends to make it a bit slow (Since i would need to add the formula for alot of rows).

 

[Peter_SSs]

If I wanted to combine the PNumber and date

If you mean the date just as a number like in your earlier image, then try adding this line

Sub Enter_Data()
  Dim FirstDate As Date, LastDate As Date
  Dim rBlanks As Range
  
  On Error Resume Next
  Set rBlanks = Range("K7,M7,K9,N9").SpecialCells(xlBlanks)
  On Error GoTo 0
  If rBlanks Is Nothing Then
    FirstDate = Range("K7").Value
    LastDate = Range("N7").Value
    With Range("D" & Rows.Count).End(xlUp).Offset(1).Resize(LastDate - FirstDate + 1)
      .Value = Evaluate("Row(" & CLng(FirstDate) & ":" & CLng(LastDate) & ")")
      .NumberFormat = "dd-mmm-yy"
      .Offset(, 1).Value = Range("N9").Value
      .Offset(, -2).Value = Range("K9").Value
      .Offset(, -3).Value = Evaluate(.Offset(, -2).Address & "&" & .Address)
    End With
  Else
    MsgBox "Data missing"
  End If
End Sub