Attempting to copy/paste data from one worksheet to another (same info but diff layout) based on dat

[tdb770]

I am attempting to create an Excel 2003 routine that will copy/paste
information from one worksheet (Raw Data) into another worksheet
(Report) within the same workbook based on a date range captured by an
input box.

The only diference between the two worksheets is the orientation of
the data. In Raw Data worksheet (input), the date column values are
listed in a single column. In the Report worksheet (ouput), the date
field values are listed across several columns (depending on the
length of month) in one row.

There are 6 columns of data being captured on the Raw Data worksheet
and transposed to the Report worksheet dependent on date column
values.


GOAL: For a given date listed in the ProcessDate Column, copy the
associated values for NetVol, ProductCode, Product, Meter ,
DestinationNode, SourceNode columns from the Raw Data worksheet and to
the appropriate column on the Report worksheet (given the change from
column to row orientation for the date values). It's sort of like
doing a copy, transpose of the data, but I need the routine to be able
to detect the changes in dates and capture associated info. from each
column related to a specfic date.

In the Raw Data worksheet (Input) Some of the date values in the
ProcessDate column may or may not repeat with each change in Source
Node, Destination Node ,Meter ,Product, Product Code columns
COLLECTIVELY. Also, there may not be info. for each date - so not all
dates in a month may be listed. That's why I have the input box
method capturing the beginning date and subsequent autfill set, to
"set up" the date row in the Report worsheet (Output).


******
I am missing a few steps and getting a bit frustrated lacking the
missing pieces... Any direction would be greatly appreciated. This
procedure will be used for over 20 different files (all having the
same structure and format) and will elimiate manual processing.

Thanks.

Sub BuildReportA()


' Build Report routine copies and pastes transposed information from
RawDAta worksheet to Report workseet


'Switch off automatic calculation mode
Application.Calculation = xlManual

'ClearOutputRange of Report Template
Sheets("Report").Select
Range("A4:AJ9").Select
Selection.ClearContents
Range("A14:AJ21").Select
Selection.ClearContents
Range("F2:AJ2").Select
Selection.ClearContents

'Set Beginning Processing Date As Variable
Dim BeginProcessDate As Date

'Input Box To Caputure Beginning Process Date
BeginProcessDate = Application.InputBox(Prompt:="Enter Beginning
Process Date Date As MM/DD/YY", _
Title:="Beginning Process Date", Default:="", Type:=1)

'If User cancels the input box event, AutoCalc is turned back on and
exit routine
If BeginProcessDate = False Then
MsgBox "Operation Cancelled"
Calculate
Application.Calculation = xlCalculationAutomatic
Exit Sub
End If

'Format BeginProcessDate input to resolve data type mismatch error
BeginProcessDate = Format(BeginProcessDate, "Short Date")

'Set BeginProcessDateCell as value to return Begin Process Date Input
Set BeginProcessDateCell =
Worksheets("Report").Range("F2").Offset(0, 0)
BeginProcessDateCell.Value = BeginProcessDate

'Fill Date Using BeginProcessDateCell value from Input Box Across Top
Of Report Worksheet
Set SourceRange = Worksheets("Report").Range("F2")
Set fillrange = Worksheets("Report").Range("F2:AJ2")
SourceRange.AutoFill Destination:=fillrange

'Park cursor on Output Sheet ("Report")
Sheets("Report").Select
Range("A4").Select

'Park cursor on Input Sheet("Raw Data")on Process Date field
Sheets("Raw Data").Select
Range("F6").Select

Dim i As Integer

'Check for Valid BeginProcessDate and determine its position
For i = 1 To 10000
If i = 10000 Then
Calculate
Application.Calculation = xlAutomatic
Exit Sub
Else
End If

'Offset (R,C) so (1,0) is one row down, (0,1) is one column right,
(-1,0) is
' one row up, (0,-1) is one column to the left

If ActiveCell.Offset(i - 1, 0).Value = BeginProcessDate Then
Exit For
Else
End If
Next i

Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer


Dim NetVol As Variant
Dim ProductCode As Variant
Dim Product As Variant
Dim Meter As Variant
Dim DestinationNode As Variant
Dim SourceNode As Variant


Dim n As Integer

m = 0

'Turn Off Screen Flicker
Application.ScreenUpdating = False

'50 Customer Outer Loop
For j = 1 To 50

'60 day inner loop for each customer
For k = 1 To 60

'First check for non-zero production
If ActiveCell.Offset(i + k - 2, 5 * (j - 1) + 4).Value = 0 Then
GoTo NoProductionForThatDay
Else
End If

'Pick, NetVol,ProductCode etc.
NetVol = ActiveCell.Offset(i + k - 2, 5 * (j - 1) + 4).Value
ProductCode = ActiveCell.Offset(-9, 5 * (j - 1) + 2).Value
Product = ActiveCell.Offset(-9, 5 * (j - 1) + 3).Value
Meter = ActiveCell.Offset(-9, 5 * (j - 1) + 4).Value
DestinationNode = ActiveCell.Offset(-9, 5 * (j - 1) + 5).Value
SourceNode = ActiveCell.Offset(-9, 5 * (j - 1) + 6).Value


'Post Results in Output Sheet
Sheets("Report").Select
ActiveCell.Offset(m, 0).Value = CurrentDate
ActiveCell.Offset(m, 3).Value = NetVol
ActiveCell.Offset(m, 4).Value = ProductCode
ActiveCell.Offset(m, 5).Value = Meter
ActiveCell.Offset(m, 6).Value = DestinationNode
ActiveCell.Offset(m, 7).Value = SourceNode


'Turn On Screen Flicker
Application.ScreenUpdating = True

End Sub

 

[Bernie Deitrick]

Try using the autofilter capability - along the lines of the macro below.

HTH,
Bernie
MS Excel MVP

Sub BuildReportB()
Dim BeginProcessDate As String
Dim EndProcessDate As String

'Input Box To Caputure Beginning Process Date
BeginProcessDate = Application.InputBox( _
Prompt:="Enter Beginning Process Date Date As MM/DD/YY", _
Title:="Beginning Process Date", Default:="", Type:=1)
'If User cancels the input box event,
'AutoCalc is turned back on and exit routine
If BeginProcessDate = False Then
MsgBox "Operation Cancelled"
Calculate
Application.Calculation = xlCalculationAutomatic
Exit Sub
End If
'Format BeginProcessDate input to resolve data type mismatch error
BeginProcessDate = Format(BeginProcessDate, "Short Date")

'Input Box To Caputure End Process Date
EndProcessDate = Application.InputBox( _
Prompt:="Enter Ending Process Date Date As MM/DD/YY", _
Title:="Ending Process Date", Default:="", Type:=1)
'If User cancels the input box event,
'AutoCalc is turned back on and exit routine
If EndProcessDate = False Then
MsgBox "Operation Cancelled"
Calculate
Application.Calculation = xlCalculationAutomatic
Exit Sub
End If
'Format BeginProcessDate input to resolve data type mismatch error
EndProcessDate = Format(EndProcessDate, "Short Date")

With Worksheets("Raw Data").Range("A1")
.AutoFilter Field:=1, Criteria1:=">" & _
BeginProcessDate, Operator:=xlAnd, _
Criteria2:="<=" & EndProcessDate
.CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
End With
Worksheets("Output Sheet").Range("A1").PasteSpecial _
Paste:=xlPasteValues, Transpose:=True
End Sub