Hi All


I am working with an existing worksheet macro and I would like it
changed to a regular module macro so I can assign it to a button. The
macro is split into a workbook macro and a Private sub module macro.
I want to be able to step through the code so I can see how changes
made effect it. I can’t currently do this.

The macro calculates FIFO for a inventory system and does that
particular task well.

The columns are such.

Date , start Inventory, Units Received, COGS, shipped, end inventory,
FIFO Calc

I want to assign the code to a button. I can’t do this the way it is
set out. I would really appreciate any assistance.

Take care

Chad

‘WORKBOOK CODE


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Excel.Range)

Dim Recd As Long 'Column
Dim Costs As Long 'Column
Dim shipped As Long 'Column

'CHANGE TO SUIT: Also change in Sub Recalc
'Units Received Column
Recd = 3
'Costs of Goods Received Column
Costs = 4
'Shipped Column
shipped = 5
'END CHANGE

'On Error GoTo endo

With Application
'no recursion
.EnableEvents = False
'speed
.ScreenUpdating = False
End With

'get last row of data based on col A
lastrow = Range("A65536").End(xlUp).Row

'was Received/Cost/Shipped?
If Not Intersect(Target, Range(Cells(3, Recd).Address,
Cells(lastrow, shipped).Address)) Is Nothing Then
'In/Cost columns are useless without each other
If Target.Column = Costs And Cells(Target.Row, Recd) = 0 Then
GoTo endo
If Target.Column = Recd And Cells(Target.Row, Costs) = 0 Then
GoTo endo
'valid
ReCalc (lastrow)
End If

endo:

'reset
With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub

REGULAR MODULE CODE (PRIVATE SUB – NO STEP THROUGH)


Option Explicit

Sub ReCalc(EndRow As Long)

Dim i As Long 'Loop counter
Dim Fifo As Long 'Dest Column
Dim Recd As Long 'Dest Column
Dim Costs As Long 'Dest Column
Dim shipped As Long 'Dest Column
Dim InRow As Long 'Current Rec'd row
Dim InVal As Long 'Current Rec'd value
Dim ShpVal As Long 'Total shipped
Dim InOut As Long 'InVal - OutVal
Dim OutVal As Long 'Shipped counter
Dim OpenI As Range 'Address for opening inventory
Dim InvCost As Double 'Calculated cost
Dim eMsg As String 'Error message
Dim ws As Worksheet 'This worksheet

Set ws = ActiveSheet

'CHANGE TO SUIT
'Address for Opening Inventory
Set OpenI = Range("B1")
'First Row of data
InRow = 3
'Change this also in Sheet Change Sub
'Units Received Column
Recd = 3
'Change this also in Sheet Change Sub
'Costs of Goods Received Column
Costs = 4
'Shipped Column
shipped = 5
'FIFO Valuation column
Fifo = 7
'END CHANGE

With ws
'Opening Inventory (if greater than zero) must be
' entered as Received items and costs
If .Cells(InRow, Recd) = 0 Then
'Error
eMsg = MsgBox("Error. No initial Received items.",
vbExclamation)
'Select Units Received/firstrow
.Cells(InRow, Recd).Select
'bail
Exit Sub
End If

' Presumes either Shipped OR Received in row, not both.

'do all rows
For i = InRow To EndRow
'Received in this row?
If .Cells(i, Recd) 0 Then
'calc cost of received
InvCost = InvCost + .Cells(i, Recd) * .Cells(i, Costs)
'put costs in FIFO Column
.Cells(i, Fifo) = InvCost
Else
'Shipped. Loop till all acounted for
Do
'Calc remaining available from current Rec'd
InOut = .Cells(InRow, Recd) - OutVal
'if not set by loop
If ShpVal = 0 Then
'Get number shipped in this row
ShpVal = .Cells(i, shipped)
End If
'check if less than current Rec'd value
If ShpVal <= InOut Then
'calc costs
InvCost = InvCost - (ShpVal * .Cells(InRow,
Costs))
'put costs in current row, FIFO Column
.Cells(i, Fifo) = InvCost
'reset outvalue
OutVal = OutVal + ShpVal
'reset shpval
ShpVal = 0
'go for next
Exit Do
Else
'calc costs
InvCost = InvCost - (InOut * .Cells(InRow,
Costs))
'put costs in current row, FIFO Column
.Cells(i, Fifo) = InvCost
'set
ShpVal = ShpVal - InOut
'get next received value
Do
'incr Received row
InRow = InRow + 1
If .Cells(InRow, Recd) 0 Then
'save Received value for shipped
InVal = .Cells(InRow, Recd)
'reset
OutVal = 0
Exit Do
End If
Loop
End If
Loop
End If
Next i
End With
End Sub

You can step through it, but you need to put a breakpoint at the beginning of
the worksheet_change code somewhere before you make a change to the
worksheet. Then you can step through it.

If you want to move it to another module, create a new module, Copy the
existing code to that module and if you still need a Worksheet_Change, create
something that calls that module.

--
HTH,
Barb Reinhardt



"Chad" wrote:

Hi All


I am working with an existing worksheet macro and I would like it
changed to a regular module macro so I can assign it to a button. The
macro is split into a workbook macro and a Private sub module macro.
I want to be able to step through the code so I can see how changes
made effect it. I cant currently do this.

The macro calculates FIFO for a inventory system and does that
particular task well.

The columns are such.

Date , start Inventory, Units Received, COGS, shipped, end inventory,
FIFO Calc

I want to assign the code to a button. I cant do this the way it is
set out. I would really appreciate any assistance.

Take care

Chad

€˜WORKBOOK CODE


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Excel.Range)

Dim Recd As Long 'Column
Dim Costs As Long 'Column
Dim shipped As Long 'Column

'CHANGE TO SUIT: Also change in Sub Recalc
'Units Received Column
Recd = 3
'Costs of Goods Received Column
Costs = 4
'Shipped Column
shipped = 5
'END CHANGE

'On Error GoTo endo

With Application
'no recursion
.EnableEvents = False
'speed
.ScreenUpdating = False
End With

'get last row of data based on col A
lastrow = Range("A65536").End(xlUp).Row

'was Received/Cost/Shipped?
If Not Intersect(Target, Range(Cells(3, Recd).Address,
Cells(lastrow, shipped).Address)) Is Nothing Then
'In/Cost columns are useless without each other
If Target.Column = Costs And Cells(Target.Row, Recd) = 0 Then
GoTo endo
If Target.Column = Recd And Cells(Target.Row, Costs) = 0 Then
GoTo endo
'valid
ReCalc (lastrow)
End If

endo:

'reset
With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub

REGULAR MODULE CODE (PRIVATE SUB €“ NO STEP THROUGH)


Option Explicit

Sub ReCalc(EndRow As Long)

Dim i As Long 'Loop counter
Dim Fifo As Long 'Dest Column
Dim Recd As Long 'Dest Column
Dim Costs As Long 'Dest Column
Dim shipped As Long 'Dest Column
Dim InRow As Long 'Current Rec'd row
Dim InVal As Long 'Current Rec'd value
Dim ShpVal As Long 'Total shipped
Dim InOut As Long 'InVal - OutVal
Dim OutVal As Long 'Shipped counter
Dim OpenI As Range 'Address for opening inventory
Dim InvCost As Double 'Calculated cost
Dim eMsg As String 'Error message
Dim ws As Worksheet 'This worksheet

Set ws = ActiveSheet

'CHANGE TO SUIT
'Address for Opening Inventory
Set OpenI = Range("B1")
'First Row of data
InRow = 3
'Change this also in Sheet Change Sub
'Units Received Column
Recd = 3
'Change this also in Sheet Change Sub
'Costs of Goods Received Column
Costs = 4
'Shipped Column
shipped = 5
'FIFO Valuation column
Fifo = 7
'END CHANGE

With ws
'Opening Inventory (if greater than zero) must be
' entered as Received items and costs
If .Cells(InRow, Recd) = 0 Then
'Error
eMsg = MsgBox("Error. No initial Received items.",
vbExclamation)
'Select Units Received/firstrow
.Cells(InRow, Recd).Select
'bail
Exit Sub
End If

' Presumes either Shipped OR Received in row, not both.

'do all rows
For i = InRow To EndRow
'Received in this row?
If .Cells(i, Recd) 0 Then
'calc cost of received
InvCost = InvCost + .Cells(i, Recd) * .Cells(i, Costs)
'put costs in FIFO Column
.Cells(i, Fifo) = InvCost
Else
'Shipped. Loop till all acounted for
Do
'Calc remaining available from current Rec'd
InOut = .Cells(InRow, Recd) - OutVal
'if not set by loop
If ShpVal = 0 Then
'Get number shipped in this row
ShpVal = .Cells(i, shipped)
End If
'check if less than current Rec'd value
If ShpVal <= InOut Then
'calc costs
InvCost = InvCost - (ShpVal * .Cells(InRow,
Costs))
'put costs in current row, FIFO Column
.Cells(i, Fifo) = InvCost
'reset outvalue
OutVal = OutVal + ShpVal
'reset shpval
ShpVal = 0
'go for next
Exit Do
Else
'calc costs
InvCost = InvCost - (InOut * .Cells(InRow,
Costs))
'put costs in current row, FIFO Column
.Cells(i, Fifo) = InvCost
'set
ShpVal = ShpVal - InOut
'get next received value
Do
'incr Received row
InRow = InRow + 1
If .Cells(InRow, Recd) 0 Then
'save Received value for shipped
InVal = .Cells(InRow, Recd)
'reset
OutVal = 0
Exit Do
End If
Loop
End If
Loop
End If
Next i
End With
End Sub

Hi

Thanks for the response. My primary purpose was to add the code to a
button so I can change it when I want. Stepping through it after this
point would have been a bonus.

Can anyone help with adding a worksheet code to a module so I can add
it to a button.

Chad

Private Sub MyButtonMacro()
Dim Recd As Long 'Column
Dim Costs As Long 'Column
Dim shipped As Long 'Column

'CHANGE TO SUIT: Also change in Sub Recalc
'Units Received Column
Recd = 3
'Costs of Goods Received Column
Costs = 4
'Shipped Column
shipped = 5
'END CHANGE

'On Error GoTo endo

With Application
'no recursion
.EnableEvents = False
'speed
.ScreenUpdating = False
End With

With ActiveSheet

'get last row of data based on col A
lastrow = .Range("A65536").End(xlUp).Row

'was Received/Cost/Shipped?
If Not Intersect(ActiveCell, Range(.Cells(3, Recd).Address,
..Cells(lastrow, shipped).Address)) Is Nothing Then
'In/Cost columns are useless without each other
If ActiveCell.Column = Costs And .Cells(ActiveCell.Row, Recd) =
0 Then GoTo endo
If TarActiveCellget.Column = Recd And .Cells(ActiveCell.Row,
Costs) = 0 Then GoTo endo
'valid
ReCalc (lastrow)
End If
End With

endo:
'reset
With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub

--
__________________________________
HTH

Bob

"Chad" wrote in message
...
Hi

Thanks for the response. My primary purpose was to add the code to a
button so I can change it when I want. Stepping through it after this
point would have been a bonus.

Can anyone help with adding a worksheet code to a module so I can add
it to a button.

Chad

Thanks very much for both your comments. With further playing around
with the code your answers have helped me out. So very greatful for
your knowledge.

Take care

Chad