Need help with date identifiers

smorales1222

New Member
Joined
Oct 27, 2011
Messages
1
:confused:

I am using the following Macro to populate information from one spreadsheet into another. i am having an issue with the date. The Purchasing spreadsheet just has an order date but the test spreadhseet has it broken out by month. Any ideas??
'*****************************************************************************
' Copies cells F, G, M, A from this spreadsheet|2011 Ordered to Budget_TEST|CapEx
' (modify filename as needed below). Expects destination spreadsheet to be
' open (change this by using the commented workbook.open method below)
'
' Determines the destination files last row to write to the end of sheet
'
' CAUTION: Starts from row 2 of the worksheet each time, behavior could
' be changed depending on desired behavior. This is currently governed
' by the hardcoded 2 in the loop, see comments in code
'*****************************************************************************
Sub CopyCAPEXData()
Dim DestWorkBook As Workbook
Dim SourceSheet As Worksheet
Dim DestSheet As Worksheet
Set SourceSheet = ActiveSheet
'*Modify filename below as needed
Set DestWorkBook = Workbooks("111010_DDMG_Technology_Working_Budget_Plan_v1.0 TEST.xlsx") '*if you want to load instead: Workbooks.Open("Z:\Documents\Budget_test.xlsx")
Set DestSheet = DestWorkBook.Worksheets("CAPEX")

Dim sRow As Long '* governs source start row for data transfer
Dim dRow As Long 'row index on destination worksheet
Dim sCount As Long 'count of rows copied
Dim LastRow As Long 'last row of source sheet
sCount = 0
LastRow = ActiveSheet.Cells.Find(what:="*", after:=ActiveSheet.Cells(1, 1), searchorder:=1, searchdirection:=2).Row + 1
dRow = DestSheet.Cells.Find(what:="*", after:=DestSheet.Cells(1, 1), searchorder:=1, searchdirection:=2).Row + 1

With SourceSheet

'skip the header to avoid writing a non zero value
'modify sRow to change source row behavior
For sRow = 2 To LastRow

'copy if capex value > 0
If .Cells(sRow, "G") > 0 Then

SourceSheet.Cells(sRow, "F").Copy Destination:=DestSheet.Cells(dRow, "D") 'Copy Description
'And (.Cells(sRow, "A") Between #09/1/11# And #10/1/11#) Then .Cells(sRow, "G").Copy Destination:=DestSheet.Cells(dRow, "P") 'Copy Value If ((Date >= (.Cells(sRow, "A"))("09/1/11"(Order Date <"10/1/11")
'.Cells(sRow, "G").Copy Destination:=DestSheet.Cells(dRow, "Q") 'Copy Value If ((Date >= Order Date("10/1/11"(Order Date <"11/1/11")
.Cells(sRow, "M").Copy Destination:=DestSheet.Cells(dRow, "G") 'Copy Notes
.Cells(sRow, "A").Copy Destination:=DestSheet.Cells(dRow, "A") 'Copy Date
.Cells(sRow, "E").Copy Destination:=DestSheet.Cells(dRow, "B") 'Copy PO

dRow = dRow + 1
sCount = sCount + 1

End If

If .Cells(sRow, "G") > 0 And .Cells(sRow, "A") >= OrderDate(#10/1/2011#)(OrderDate < (#11/1/2011#)) Then

'SourceSheet.Cells(sRow, "F").Copy Destination:=DestSheet.Cells(dRow, "D") 'Copy Description
'Then .Cells(sRow, "G").Copy Destination:=DestSheet.Cells(dRow, "P") 'Copy Value If ((Date >= (.Cells(sRow, "A"))("09/1/11"(Order Date <"10/1/11")
'.Cells(sRow, "G").Copy Destination:=DestSheet.Cells(dRow, "Q") 'Copy Value If ((Date >= Order Date("10/1/11"(Order Date <"11/1/11")
'.Cells(sRow, "M").Copy Destination:=DestSheet.Cells(dRow, "G") 'Copy Notes
'.Cells(sRow, "A").Copy Destination:=DestSheet.Cells(dRow, "A") 'Copy Date
'.Cells(sRow, "E").Copy Destination:=DestSheet.Cells(dRow, "B") 'Copy PO

dRow = dRow + 1
sCount = sCount + 1

End If
Next sRow
End With
MsgBox sCount & " rows copied", vbInformation, "Transfer Done"
End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

Forum statistics

Threads
1,214,918
Messages
6,122,249
Members
449,075
Latest member
staticfluids

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top