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:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]RQ[/TD]
[TD]SS[/TD]
[TD]Start[/TD]
[TD]End[/TD]
[TD]Rls[/TD]
[TD]Disp[/TD]
[TD]Type[/TD]
[TD]BP[/TD]
[TD]WO[/TD]
[TD]Sta[/TD]
[TD]Scope[/TD]
[TD]Remarks[/TD]
[/TR]
[TR]
[TD]435645[/TD]
[TD]23254[/TD]
[TD]2/3/2018[/TD]
[TD]5/1/2019[/TD]
[TD]Y[/TD]
[TD]D[/TD]
[TD]Clr[/TD]
[TD]7587[/TD]
[TD]095677[/TD]
[TD]Sta1[/TD]
[TD]Scope1[/TD]
[TD]Remarks 1[/TD]
[/TR]
[TR]
[TD]456452[/TD]
[TD]26446[/TD]
[TD]5/20/2018[/TD]
[TD]12/4/2020[/TD]
[TD]N[/TD]
[TD]T[/TD]
[TD]Clr[/TD]
[TD]5678[/TD]
[TD]546784[/TD]
[TD]Sta2[/TD]
[TD]Scope2[/TD]
[TD]Remarks 2[/TD]
[/TR]
</tbody>[/TABLE]
VBA Code for the 2 Week Look Ahead button below:
Example outage sheet:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]RQ[/TD]
[TD]SS[/TD]
[TD]Start[/TD]
[TD]End[/TD]
[TD]Rls[/TD]
[TD]Disp[/TD]
[TD]Type[/TD]
[TD]BP[/TD]
[TD]WO[/TD]
[TD]Sta[/TD]
[TD]Scope[/TD]
[TD]Remarks[/TD]
[/TR]
[TR]
[TD]435645[/TD]
[TD]23254[/TD]
[TD]2/3/2018[/TD]
[TD]5/1/2019[/TD]
[TD]Y[/TD]
[TD]D[/TD]
[TD]Clr[/TD]
[TD]7587[/TD]
[TD]095677[/TD]
[TD]Sta1[/TD]
[TD]Scope1[/TD]
[TD]Remarks 1[/TD]
[/TR]
[TR]
[TD]456452[/TD]
[TD]26446[/TD]
[TD]5/20/2018[/TD]
[TD]12/4/2020[/TD]
[TD]N[/TD]
[TD]T[/TD]
[TD]Clr[/TD]
[TD]5678[/TD]
[TD]546784[/TD]
[TD]Sta2[/TD]
[TD]Scope2[/TD]
[TD]Remarks 2[/TD]
[/TR]
</tbody>[/TABLE]
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