Please help me create a macro that will have the source Worksheet as
Sheet1 and the destination worksheet as discount that corresponds to the
data listed below. Each row from Sheet1 corresponds to two rows in Discount
worksheet.

Every row that corresponds to Cost column (E) has a Cost Code = 0007346
and Discount column (K) has a Discount Code = 0007346 and this value place
in the Column G of the Discount worksheet.

The Sheet1 usually has 60 days of data.

Thanks,



Category
Cost Code = 0007234
Discount Code = 0007346


Worksheet(Sheet1)
Date(B06) Cost(E06) Discount(K06)
01/01/2003 5.67 1.32
01/02/2003 15.24 3.34
01/03/2003 12.13 2.09
....
03/01/2003 8.48 1.68

Worksheet(Discount)

Col(C) Date Col(F) Cost Col(G) Category
01/01/2003 5.67 0007234
01/01/2003 1.32 0007346
01/02/2003 15.24 0007234
01/02/2003 3.34 0007346
01/03/2003 12.13 0007234
01/03/2003 2.09 0007346
....
03/01/2003 8.48 0007234
03/01/2003 1.68 0007346

Sub move_to_discount()

Const CostCode = 7234
Const DiscountCode = 7346

With Sheets("Discount")
DisLastRow = .Cells(Rows.Count, "C").End(xlUp).Row
End With

DisRowCount = DisLastRow + 1

With Sheets("Sheet1")
Sh1LastRow = .Cells(Rows.Count, "B").End(xlUp).Row

For Sh1RowCount = 2 To Sh1LastRow
ItemDate = .Cells(Sh1RowCount, "B")
Cost = .Cells(Sh1RowCount, "E")
Discount = .Cells(Sh1RowCount, "K")

With Sheets("Discount")
.Cells(DisRowCount, "C") = ItemDate
.Cells(DisRowCount, "F") = Cost
.Cells(DisRowCount, "G") = CostCode
DisRowCount = DisRowCount + 1
.Cells(DisRowCount, "C") = ItemDate
.Cells(DisRowCount, "F") = Discount
.Cells(DisRowCount, "G") = DiscountCode
DisRowCount = DisRowCount + 1
End With

Next Sh1RowCount
End With

End Sub


"Joe K." wrote:


Please help me create a macro that will have the source Worksheet as
Sheet1 and the destination worksheet as discount that corresponds to the
data listed below. Each row from Sheet1 corresponds to two rows in Discount
worksheet.

Every row that corresponds to Cost column (E) has a Cost Code = 0007346
and Discount column (K) has a Discount Code = 0007346 and this value place
in the Column G of the Discount worksheet.

The Sheet1 usually has 60 days of data.

Thanks,



Category
Cost Code = 0007234
Discount Code = 0007346


Worksheet(Sheet1)
Date(B06) Cost(E06) Discount(K06)
01/01/2003 5.67 1.32
01/02/2003 15.24 3.34
01/03/2003 12.13 2.09
...
03/01/2003 8.48 1.68

Worksheet(Discount)

Col(C) Date Col(F) Cost Col(G) Category
01/01/2003 5.67 0007234
01/01/2003 1.32 0007346
01/02/2003 15.24 0007234
01/02/2003 3.34 0007346
01/03/2003 12.13 0007234
01/03/2003 2.09 0007346
...
03/01/2003 8.48 0007234
03/01/2003 1.68 0007346

Hi Joe,

I see that Joel has posted a reply while I was dragging my feet getting one
ready. From your previous post I assume that you are on a learning curve so
I'll post the code I came up with. (That does not mean that I am critical of
Joel's code because that is not the case. It is simply to show you another
option.)

Sub Copy_Data()

Dim rngSht1 As Range
Dim wsDisc As Worksheet
Dim strCostCode As String
Dim strDiscount As String
Dim c As Range

strCostCode = "0007234"
strDiscount = "0007346"

With Sheets("Sheet1")
Set rngSht1 = Range(.Cells(6, 2), _
.Cells(Rows.Count, 2).End(xlUp))
End With

Set wsDisc = Sheets("Discount")

With wsDisc
.Cells(1, 3) = "Date"
.Cells(1, 6) = "Cost"
.Cells(1, 7) = "Category"
'Format col G as text otherwise
'leading zeros will be dropped.
.Columns("G:G").NumberFormat = "@"
End With

For Each c In rngSht1
'First row of data
'Copy paste Date
c.Copy _
wsDisc.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)

'Copy paste Cost
c.Offset(0, 3).Copy _
wsDisc.Cells(Rows.Count, 3).End(xlUp).Offset(0, 3)

'Insert Cost Code
wsDisc.Cells(Rows.Count, 3).End(xlUp).Offset(0, 4) _
= strCostCode
'Alternative if Discount code is in a cell
'wsDisc.Cells(Rows.Count, 3).End(xlUp).Offset(0, 4) _
= wsDisc.Range("I2")


'Second row of data
'Copy paste Date
c.Copy _
wsDisc.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)

'Copy paste Discount
c.Offset(0, 9).Copy _
wsDisc.Cells(Rows.Count, 3).End(xlUp).Offset(0, 3)

'Insert Discount Code
wsDisc.Cells(Rows.Count, 3).End(xlUp).Offset(0, 4) _
= strDiscount
'Alternative if Discount code is in a cell
'wsDisc.Cells(Rows.Count, 3).End(xlUp).Offset(0, 4) _
= wsDisc.Range("J2")

Next c

End Sub


Regards,

OssieMac

I triy to make code easily readable so it can be maintained and changed in
the future. the Computer science courses I took in college the teachers
insisted on clear documentation.

My prefedrence is to avoid using OFFSET in functions unless it is necessary.
In my code I selected the column letters (cells(RowCount,"C") when I did the
copy instruction.

I believe the offset should only be used when you need tthe code to be
flexible that the selected cell can vary. In this case the columns and rows
are known so I don't think the offset is necessary.

Additionally, offsets are sometimes the better way of going because the code
runs quicker (in some cases).

"OssieMac" wrote:

Hi Joe,

I see that Joel has posted a reply while I was dragging my feet getting one
ready. From your previous post I assume that you are on a learning curve so
I'll post the code I came up with. (That does not mean that I am critical of
Joel's code because that is not the case. It is simply to show you another
option.)

Sub Copy_Data()

Dim rngSht1 As Range
Dim wsDisc As Worksheet
Dim strCostCode As String
Dim strDiscount As String
Dim c As Range

strCostCode = "0007234"
strDiscount = "0007346"

With Sheets("Sheet1")
Set rngSht1 = Range(.Cells(6, 2), _
.Cells(Rows.Count, 2).End(xlUp))
End With

Set wsDisc = Sheets("Discount")

With wsDisc
.Cells(1, 3) = "Date"
.Cells(1, 6) = "Cost"
.Cells(1, 7) = "Category"
'Format col G as text otherwise
'leading zeros will be dropped.
.Columns("G:G").NumberFormat = "@"
End With

For Each c In rngSht1
'First row of data
'Copy paste Date
c.Copy _
wsDisc.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)

'Copy paste Cost
c.Offset(0, 3).Copy _
wsDisc.Cells(Rows.Count, 3).End(xlUp).Offset(0, 3)

'Insert Cost Code
wsDisc.Cells(Rows.Count, 3).End(xlUp).Offset(0, 4) _
= strCostCode
'Alternative if Discount code is in a cell
'wsDisc.Cells(Rows.Count, 3).End(xlUp).Offset(0, 4) _
= wsDisc.Range("I2")


'Second row of data
'Copy paste Date
c.Copy _
wsDisc.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)

'Copy paste Discount
c.Offset(0, 9).Copy _
wsDisc.Cells(Rows.Count, 3).End(xlUp).Offset(0, 3)

'Insert Discount Code
wsDisc.Cells(Rows.Count, 3).End(xlUp).Offset(0, 4) _
= strDiscount
'Alternative if Discount code is in a cell
'wsDisc.Cells(Rows.Count, 3).End(xlUp).Offset(0, 4) _
= wsDisc.Range("J2")

Next c

End Sub


Regards,

OssieMac