Hi, i was wondering if anyone can help me figure out, why In the Column D on the LOG sheet, numbers dont appear with decimals
VBA Code:
Option Base 1
Sub FIFO()
'
Dim QtySold() As Long, SKU_TYPE() As String, SalesINV() As String, source() As String, Cost() As Double
Dim i As Integer, t As Integer, pending As Integer, matched As Integer, j As Integer, x As Double
Dim rngA As Range
Dim cell As Range
' [URL='http://www.excel4routine.com']www.excel4routine.com[/URL]
' ZKL 13/04/19
Application.ScreenUpdating = False
'if inventory records < 1 row exit sub
'else add remaining column fill down
With ActiveSheet
If .Cells(.Rows.Count, "A").End(xlUp).Row > 2 Then
'Sort Inventory by Pdt,by Date
'[URL='https://trumpexcel.com/sort-data-vba/']How to Sort Data in Excel using VBA (A Step-by-Step Guide)[/URL]
With ActiveSheet.Sort
.SortFields.Clear ' to clear prior sort data
.SortFields.Add Key:=Range("B1"), Order:=xlAscending
.SortFields.Add Key:=Range("A1"), Order:=xlAscending
.SetRange Range("mydata")
.Header = xlYes
.Apply
End With
.Range("G2:G" & .Cells(.Rows.Count, "C").End(xlUp).Row).Formula = "=C2-F2"
.Range("H2:H" & .Cells(.Rows.Count, "C").End(xlUp).Row).Formula = "=G2*D2"
.Range("O2:O" & .Cells(.Rows.Count, "K").End(xlUp).Row).Formula = "=SUMIFs(LOG!F:F,LOG!A:A,K2,LOG!C:C,L2)"
End If
End With
'Check Availability of stock for those pending insufficient cases
Set rngA = ActiveSheet.Range("P2:P" & ActiveSheet.Cells(ActiveSheet.Rows.Count, "P").End(xlUp).Row)
t = 0
For Each cell In rngA
If cell.Value = "Insufficient Stock" Then
If Not WorksheetFunction.SumIf(ActiveSheet.Range("B:B"), ActiveSheet.Range("L" & cell.Row).Value, ActiveSheet.Range("G:G")) < ActiveSheet.Range("M" & cell.Row).Value Then
ActiveSheet.Range("N" & cell.Row).Value = ActiveSheet.Range("M" & cell.Row).Value
ActiveSheet.Range("P" & cell.Row).ClearContents
'Narrow down the range for SKU lookup
'goto by find
Let endrow = Columns("B:B").Find(What:=ActiveSheet.Range("L" & cell.Row).Value, After:=ActiveSheet.Range("B1"), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
False, SearchFormat:=False).Row
Let startrow = Columns("B:B").Find(What:=ActiveSheet.Range("L" & cell.Row).Value, After:=ActiveSheet.Range("B1"), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Row
x = ActiveSheet.Range("M" & cell.Row).Value
'Loop through Inventory
For i = startrow To endrow
With Range("B" & i)
If x <> 0 And .Offset(, 5).Value > 0 Then
t = t + 1
ReDim Preserve QtySold(t)
ReDim Preserve SKU_TYPE(t) 'Range("L" & j).Value
ReDim Preserve SalesINV(t) 'Range("K" & j).Value
ReDim Preserve source(t) '.Offset(, 3)
ReDim Preserve Cost(t) '.Offset(, 2)
If .Offset(, 5).Value >= x Then
.Offset(, 4) = .Offset(, 4) + x
QtySold(t) = x
SKU_TYPE(t) = ActiveSheet.Range("L" & cell.Row).Value
SalesINV(t) = ActiveSheet.Range("K" & cell.Row).Value
source(t) = .Offset(, 3)
Cost(t) = .Offset(, 2)
x = 0
Else
SKU_TYPE(t) = ActiveSheet.Range("L" & cell.Row).Value
SalesINV(t) = ActiveSheet.Range("K" & cell.Row).Value
source(t) = .Offset(, 3)
Cost(t) = .Offset(, 2)
QtySold(t) = .Offset(, 5).Value
x = x - .Offset(, 5).Value
.Offset(, 4) = .Offset(, 4) + .Offset(, 5)
End If
End If
End With
Next i
End If
End If
Next cell
'Do a check for new orders pending to be matched comparing the last row of col M & N
Let pending = Columns("M:M").Find(What:="*", After:=ActiveSheet.Range("M1"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
False, SearchFormat:=False).Row
Let matched = Columns("N:N").Find(What:="*", After:=ActiveSheet.Range("N1"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
False, SearchFormat:=False).Row
'Do a check for availability of remaining inventory b4 going on
'Loop through sales order .if stock available proceed to match else just 0 and skip to next iteration
For j = matched + 1 To pending
If WorksheetFunction.SumIf(ActiveSheet.Range("B:B"), ActiveSheet.Range("L" & j).Value, ActiveSheet.Range("G:G")) < ActiveSheet.Range("M" & j).Value Then
Range("N" & j).Value = 0
Range("P" & j).Value = "Insufficient Stock" 'Update those outstanding "insufficient stocks" that are just matched to LOG
GoTo NextIteration:
Else
Range("N" & j).Value = Range("M" & j).Value
End If
'Narrow down the range for SKU lookup
'goto by find
Let endrow = Columns("B:B").Find(What:=ActiveSheet.Range("L" & j).Value, After:=ActiveSheet.Range("B1"), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
False, SearchFormat:=False).Row
Let startrow = Columns("B:B").Find(What:=ActiveSheet.Range("L" & j).Value, After:=ActiveSheet.Range("B1"), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Row
x = ActiveSheet.Range("M" & j).Value
'Loop through Inventory
For i = startrow To endrow
With Range("B" & i)
If x <> 0 And .Offset(, 5).Value > 0 Then
t = t + 1
ReDim Preserve QtySold(t)
ReDim Preserve SKU_TYPE(t) 'Range("L" & j).Value
ReDim Preserve SalesINV(t) 'Range("K" & j).Value
ReDim Preserve source(t) '.Offset(, 3)
ReDim Preserve Cost(t) '.Offset(, 2)
If .Offset(, 5).Value >= x Then
.Offset(, 4) = .Offset(, 4) + x
QtySold(t) = x
SKU_TYPE(t) = ActiveSheet.Range("L" & j).Value
SalesINV(t) = ActiveSheet.Range("K" & j).Value
source(t) = .Offset(, 3)
Cost(t) = .Offset(, 2)
x = 0
Else
SKU_TYPE(t) = ActiveSheet.Range("L" & j).Value
SalesINV(t) = ActiveSheet.Range("K" & j).Value
source(t) = .Offset(, 3)
Cost(t) = .Offset(, 2)
QtySold(t) = .Offset(, 5).Value
x = x - .Offset(, 5).Value
.Offset(, 4) = .Offset(, 4) + .Offset(, 5)
End If
End If
End With
Next i
NextIteration:
Next j
'UPDATE LOG
On Error Resume Next
'[URL='http://www.cpearson.com/excel/ArraysAndRanges.aspx']Arrays And Ranges In VBA[/URL]
'Could be improved through split function I think....to be explored later
Dim Destination As Range
Set Destination = LOG.Cells(LOG.Rows.Count, "A").End(xlUp).Offset(1, 0)
Set Destination = Destination.Resize(UBound(SalesINV), 1)
Destination.Value = Application.Transpose(SalesINV)
Set Destination = LOG.Cells(LOG.Rows.Count, "B").End(xlUp).Offset(1, 0)
Set Destination = Destination.Resize(UBound(source), 1)
Destination.Value = Application.Transpose(source)
Set Destination = LOG.Cells(LOG.Rows.Count, "C").End(xlUp).Offset(1, 0)
Set Destination = Destination.Resize(UBound(SKU_TYPE), 1)
Destination.Value = Application.Transpose(SKU_TYPE)
Set Destination = LOG.Cells(LOG.Rows.Count, "D").End(xlUp).Offset(1, 0)
Set Destination = Destination.Resize(UBound(QtySold), 1)
Destination.Value = Application.Transpose(QtySold)
Set Destination = LOG.Cells(LOG.Rows.Count, "E").End(xlUp).Offset(1, 0)
Set Destination = Destination.Resize(UBound(Cost), 1)
Destination.Value = Application.Transpose(Cost)
LOG.Range("F2:F" & LOG.Cells(LOG.Rows.Count, "E").End(xlUp).Row).Formula = "=E2*D2"
'''''End If
With ActiveSheet
.Range("Orders").Value = .Range("Orders").Value
.Range("MyData").Value = .Range("MyData").Value
End With
DoEvents
Application.ScreenUpdating = True
End Sub
Last edited by a moderator:
