sparkytech
Board Regular
- Joined
- Mar 6, 2018
- Messages
- 96
- Office Version
- 365
- 2019
I currently have a sheet with an "outage info" table and a start/end date for each outage. I have a '2 Week Lookahead' button on this sheet that runs a macro to copy any rows with outages that fall within the next 2 weeks to an existing worksheet titled '2 Week Look Ahead'. The code currently has an input box for the start/end dates, but I would like it to automatically calculate 2 weeks from this weeks start date. I used some code I found as a starting point. I have tried modifying it... it sort of works, but am stuck. I can't seem to make the macro look at columns C & D for dates, and i am not sure how to automate the 2 week date range. Please forgive the code errors, as this is a work in progress by a total noob. Any help would be greatly appreciated!
Example outage sheet:
<tbody>
</tbody>
VBA Code for the 2 Week Look Ahead button below:
Example outage sheet:
RQ | SS | Start | End | Rls | Disp | Type | BP | WO | Sta | Scope | Remarks |
435645 | 23254 | 2/3/2018 | 5/1/2019 | Y | D | Clr | 7587 | 095677 | Sta1 | Scope1 | Remarks 1 |
456452 | 26446 | 5/20/2018 | 12/4/2020 | N | T | Clr | 5678 | 546784 | Sta2 | Scope2 | Remarks 2 |
<tbody>
</tbody>
VBA Code for the 2 Week Look Ahead button below:
Code:
Sub Copy_Click()
Dim startdate As Date, enddate As Date
Dim rng As Range, destRow As Long
Dim shtSrc As Worksheet, shtDest As Worksheet
Dim c As Range '-- this is used to store the single cell in the For Each loop
Set shtSrc = Sheets("Outages")
Set shtDest = Sheets("2 Week Lookahead")
destRow = 10 'start copying to this row on destination sheet
startdate = CDate(InputBox("Begining Date"))
enddate = CDate(InputBox("End Date"))
'Look for matching dates in columns D5 to E1000
Set rng = Application.Intersect(shtSrc.Range("D5:E1000"), shtSrc.UsedRange)
For Each c In rng.Cells
If c.Value >= startdate And c.Value <= enddate Then
c.Offset(0, 0).Resize(1, 10).Copy _
shtDest.Cells(destRow, 4) 'Copy a 10-cell wide block to the other sheet, paste into Col D on row destRow
destRow = destRow + 1
End If
Next
End Sub