CODEWITHSUNDEEP
vbaexceldate
M. Flinn
M. Flinn

Reputation: 1

Update start date by one day until end date as relevant data for each day within date range is recorded

I'm trying to update a date and simultaneously record each individual date and its respective z score on a separate worksheet. My excel file is is already set up so that as the date changes, the corresponding z scores for the day updates. Can anyone help me write VBA code that compiles the date with corresponding data for each day within the date range? Ideally, I want the code to adjust for a start date and end date when it is changed directly on the excel sheet. Unfortunately, I can't seem to update the date by one day without presetting it to a specific day, as an objected required error occurs for the "nextday" part of the code. 

Sub compliedataloop()

Dim wb As Workbook
Set wb = ActiveWorkbook

Dim wsprecip As Worksheet
Set wsprecip = wb.Worksheets("Precip")

Dim wshistoricaldata As Worksheet
Set wshistoricaldata = wb.Worksheets("Historical Data")

Dim nextday As String
Set nextday = wb.wsprecip.Range("CJ4")

wb.wshistoricaldata.Range("C4").Activate
wb.wsprecip.Range("CJ4").Activate
ActiveCell.Copy
wb.wshitoricaldata.Activate
ActiveCell.PasteSpecial
ActiveCell.Offset(1, 0).Activate
wb.wsprecip.Range("CN37").Activate
ActiveCell.Copy
wb.wshistoricaldata.Activate
ActiveCell.PasteSpecial
ActiveCell.Offset(-1, 1).Activate 
wb.wsprecip.Range("CJ4").Activate
nextday.DateAdd = ("d")


Do While Enddate = False

'select, copy and paste first Date from cell CJ5 in "precip" Worksheet to "historicaldata" worksheet
wb.wsprecip.Range(CJ4).Activate
ActiveCell.Copy
wb.wshistoricaldata.Activate
ActiveCell.PasteSpecial
ActiveCell.Offset(1, 0).Activate
wb.wsprecip.Range("CJ4").Activate
nextday.DateAdd = ("d")
'copy new z-score for new date and paste data into "historicaldata" worksheet
wbs.wsprecip.Range("CN37").Activate
ActiveCell.Copy
wb.wshistoricaldata.Activate
ActiveCell.Offset(0, 1).Activate
ActiveCell.PasteSpecial
'reset positioning for next day's date in one cell above and to the right
ActiveCell.Offset(-1, 1).Activate

If Enddate = 2 / 28 / 2018 Then
Enddate = True
End If

End Sub

Upvotes: 0

Views: 71

Answers (1)

Profex
Profex

Reputation: 1390

I don't know where to begin...

Make sure that you have Option Explicit as the first line in the module. It will require you to define all of your variables, which stops you from randomly mistyping (wbs) or using variables (Enddate) that haven't been assigned a value.

PS please you capital letters at the start of each word in variable names, so that you can read them easier i.e. NextDay

You defined nextday as a string. A string is not an object, hence why the " object required error occurs".

If all that you are doing is adding a day, you don't need the DateAdd function, just add 1.

You don't need to use any .Activate, .copy or .PasteSpecial to just copy a value from one cell to another.

I can't exactly figure out what you are doing; specifically with your end date. Are you trying to make this run once a day and keep writing to the next column? If so, you need to fine the last column with something like this:

Public Function LastColumn(Optional Row As Integer = 1, Optional Sheet As Excel.Worksheet) As Long
    If Sheet Is Nothing Then Set Sheet = Application.ActiveSheet
    LastColumn = Sheet.Cells(Row, Sheet.Columns.Count).End(xlLeft).Row
End Function

Set cell to the empty cell (Offset) after the last cell in row 4:

Set cell = LastColumn(4, wb.wsHistoricalData).offset(0,1)

Anyway, here is what your code roughly looks like when fixed...

Option Explicit

Sub ComplieDataLoop()
Dim wb As Workbook
Dim wsPrecip As Worksheet
Dim wsHistoricalData As Worksheet
Dim NextDay As Date
'Dim EndDate As Date???
Dim cell As Range

    Set wb = ActiveWorkbook
    Set wsPrecip = wb.Worksheets("Precip")
    Set wsHistoricalData = wb.Worksheets("Historical Data")
    NextDay = wb.wsPrecip.Range("CJ4")
    'EndDate = ???
    Set cell = wb.wsHistoricalData.Range("C4")

    Do While EndDate < DateSerial( 2018, 2, 28)
        cell = wb.wsPrecip.Range("CJ4")
        Set cell = Offset(-1, 0)
        cell = wb.wsPrecip.Range("CN37")
        'reset positioning for next day's date in one cell above and to the right
        Set cell = Offset(-1, 1)
        'EndDate = ???
    Loop
End Sub

Upvotes: 0

Related Questions