CODEWITHSUNDEEP
vbaexceldate
Skyler
Skyler

Reputation: 59

How do I insert multiple date columns in order to meet a specific date?

I am really new to codes and Excel VBA, and hopefully, you guys could help me out with my question. Any tips, feedback, and comments are greatly appreciated!

Within a workbook, I want to make sure that my cell (I1) of worksheet (Sheet1) has the specific date as written in a different sheet (ie. Menu). I want I1 to be the starting point whereby subsequent dates will occur by going across the row (I1, J1, K1, etc.). In this case, if my specific date required is 15/8/16 and one of my sheet (Sheet 1) has its cell I1 written as 20/8/16, I want to know how to construct my code in such a way that,

If I1 in Sheet 1 is currently at 15/8/16, then do nothing. But if I1 in Sheet 1 is off a different later date than 15/8/16, the I1 will now begin at 15/8/16, and subsequent dates are added until it reaches the default date that was initially there at I1 (now 20/8/16 is at cell N1).

My current code is as follows:-

If ActiveSheet.Range("I1") <> MainSht.Range("D6") Then
ActiveSheet.Range("I1") = MainSht.Range("D6")
End If

Do
If Cells(1,z+1)>Cells(1,z+1) Then
Cells(1,z+1) = Cells(1,z)+1
End If
z = z+1
Loop Until Cells(1,z+1) = MainSht.Range("D7")

*Mainsht (D6) is my start date, (D7) is my end date.

My code currently does not have the insert column section because I have problems in applying both insert column and date increment code together. With my current code, my date range never expanded as it is still within the same earlier date range (same last column as before, hence last cell for date column remains as it is). How do I construct in such a way that the missing dates in between are added, and it is added by inserting columns in a repeated process?

Thanks in advance if anyone could help me out in this. Thanks for your understanding as well.

Upvotes: 2

Views: 527

Answers (2)

user3598756
user3598756

Reputation: 29421

you could try this:

Option Explicit

Sub main()
    Dim diff As Long

    With Worksheets("Work").Range("I1") '<--| reference working sheet range "I1" (change "Work" to your actual working worksheet)
        diff = .Value - Worksheets("Menu").Range("D6") ' <--| evaluate the difference between referenced range value and worksheet "Menu" cell "D6" (change "Menu" to your actual "main" sheet)
        If diff > 0 Then
            With .Resize(, diff) '<-- reference referenced range resized to the necessary columns number
                .EntireColumn.Insert xlRight '<-- insert columns
                With .Offset(, -diff).Resize(1) '<--| reference referenced range first row
                    .FormulaR1C1 = "=RC[1]-1" ' <--|  insert formulas that substracts one from the value of next cell on the right
                    .Value = .Value '<-- get rid of formulas
                    .NumberFormat = .Offset(, diff).Resize(, 1).NumberFormat '<--| format cells as the passed range
                    .EntireColumn.AutoFit '<--| adjust columns width
                End With
            End With
        End If
    End With
End Sub

Just change "Work" and "Menu" to your actual worksheets names

Upvotes: 0

Aditya Pansare
Aditya Pansare

Reputation: 1132

Please check below code to add columns

Dim start_date, end_date As Date

start_date = ThisWorkbook.Sheets("Sheet1").Range("L1").Value
end_date = ThisWorkbook.Sheets("main").Range("D7").Value

If start_date < end_date Then

    Do Until start_date = end_date
    ThisWorkbook.Sheets("Sheet1").Activate
    Range("L:L").Insert (xlRight)
    start_date = start_date + 1
    Range("L1").Value = start_date
    Loop

End If

Upvotes: 1

Related Questions