Logo 
Search:

MS Office Answers

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds
  Question Asked By: Bastet Massri   on Jan 18 In MS Office Category.

  
Question Answered By: Alyssa Kelley   on Jan 18

The following code opens a closed  workbook (InterimDataSheet.XLS),
copies new data  to it, formats and performs computations, saves and
closes the workbook. The macro  is executed from a different workbook.
It performs other functions as well, which I didn't bother to delete.
Dim EndR As Long
Dim EndDay As Long
Dim StartDay As Long
Dim CheckDay As Long
Dim OldTime As Double

' Clear old plotting data
Sheets("Plotting Data").Select
Cells.Select
Selection.ClearContents

' Identify and Copy most recent 1-year subset
Sheets("FullDataset").Select
Range("A2").Select
Selection.End(xlDown).Select
EndR = ActiveCell.Row ' finds the last row of the complete dataset
EndDay = Round(ActiveCell.Value, 0)
StartDay = Round(Now, 0) - 200 ' Back up one year from today

Range("A2").Select
CheckDay = ActiveCell.Value
Do Until CheckDay = StartDay
ActiveCell.Offset(1, 0).Select
CheckDay = ActiveCell.Value
Loop
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("FullDataset").Select

Range("J2").Select
ActiveSheet.Paste
Columns("J:J").EntireColumn.AutoFit
Range("J2:J65536").Select
Selection.NumberFormat = "[$-409]m/d/yy h:mm AM/PM;@"
Range("K2:M65536").Select
Selection.NumberFormat = "#,##0"


' Add Headers
Range("J1").Select
ActiveCell.Value = "Date"
Range("K1").Select
ActiveCell.Value = "Extended Forecast Flow (CFS)"
Range("L1").Select
ActiveCell.Value = "Forecast Flow (CFS)"
Range("M1").Select
ActiveCell.Value = "Provisional Flow (CFS)"
Range("N1").Select
ActiveCell.Value = "Approved Flow (CFS)"

' Copy 1-year subset to InterimDataFile

Workbooks.Open Filename:= _
"C:\BasinSecurity\EmergencyFlowModel\InterimDataSheet.xls"
Sheets("Delaware at Trenton").Select
Windows("InterimDataSheet.xls").Activate
Range("A1:Z65536").ClearContents
Windows("TrentonRetrieval_3.xls").Activate
Sheets("FullDataset").Select
Range("J1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Windows("InterimDataSheet.xls").Activate
Sheets("Delaware at Trenton").Select
Range("J1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

' Collapse to 2 columns

Windows("InterimDataSheet.xls").Activate
Sheets("Delaware at Trenton").Select
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
' Collapse flows to 1 column and convert from CFS to CMS
Selection.FormulaR1C1 = "=Round((SUM(RC[9]:RC[12]))/35.31,2)"
' Convert Dates and Times to UTC using Lookup table
Range("I2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.FormulaR1C1 = _
"=VLOOKUP(RC[1],'DLT to UTC conversions'!R1C2:R25C3,2,TRUE)"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.FormulaR1C1 = "=SUM(RC[8]:RC[9])"
' Delete extra rows
Range("J2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete

' Convert from formula to value

Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "[$-409]m/d/yy h:mm AM/PM;@"
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Range("C1:Z1").Select
Selection.EntireColumn.Delete

Range("A1").Select
ActiveCell.Value = "Date and Time"
Range("B1").Select
ActiveCell.Value = "Flow (CMS)"

' 3rd round - 200 days prior to NOW is day 1

'Range("A2").Select
'RowCount = ActiveCell.Row
'Selection.End(xlDown).Select
'RowCount = ActiveCell.Row - RowCount + 1

'Range("A2").Select
'For j = 1 To RowCount
' ActiveCell.Value = ActiveCell.Value - (Date - 200)
' ActiveCell.Offset(1, 0).Select
'Next j


' 5th round - remove duplicates
Range("A2").Select
RowCount = ActiveCell.Row
Selection.End(xlDown).Select
RowCount = ActiveCell.Row - RowCount + 1

OldTime = -999

Range("A2").Select
For j = 1 To RowCount
If ActiveCell.Value = OldTime Then
Selection.EntireRow.Delete
rowsleft = rowsleft - 1
Else: OldTime = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
End If
Next j

' Artificially set first data time series value to 1
'Range("A2").Select
'ActiveCell.Value = 1


ActiveWorkbook.Save
ActiveWorkbook.Close

Windows("TrentonRetrieval_3.xls").Activate
Sheets("FullDataset").Select



' Copy and Paste a 75 row subset (~ 30 days worth)
Range("J2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(-75, 0).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("FullDataset").Select
Range("Q2").Select
ActiveSheet.Paste
Range("Q1").Select
ActiveCell.Value = "Date"
Range("R1").Select
ActiveCell.Value = "Extended Forecast Flow (CFS)"
Range("S1").Select
ActiveCell.Value = "Forecast Flow (CFS)"
Range("T1").Select
ActiveCell.Value = "Provisional Flow (CFS)"
Range("U1").Select
ActiveCell.Value = "Approved Flow (CFS)"
Columns("Q:Q").EntireColumn.AutoFit

Range("Q1:U1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Plotting Data").Select
Range("A1").Select
ActiveSheet.Paste

'Format cells
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "[$-409]m/d/yy h:mm AM/PM;@"

Range("B2:E2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "#,##0"




Sheets("Trenton Flow Chart").Select

End Sub

Share: 

 
 


Tagged: