Can anyone help me figure out what to change to add more colums? Thanks in advance

Temkox

New Member
Joined
Feb 8, 2021
Messages
12
Office Version
  1. 2019
Platform
  1. Windows
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

    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
                'https://trumpexcel.com/sort-data-vba/
                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
        'http://www.cpearson.com/excel/ArraysAndRanges.aspx
        '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
Here is a screenshot FIFO_Inventory2Cogs (6) - Excel (gyazo.com)
 

Some videos you may like

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,387
Office Version
  1. 365
Platform
  1. Windows
Yeah ok no need to shout. If you add columns you will have to change the code. Cant help any further until know where the columns are going.
 

Temkox

New Member
Joined
Feb 8, 2021
Messages
12
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Yeah ok no need to shout. If you add columns you will have to change the code. Cant help any further until know where the columns are going.
srry i copied pasted the title, didnt mean wrong. Can i show you a screenshot?
 

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,387
Office Version
  1. 365
Platform
  1. Windows
There are countless places in that code where you reference a cell or cells. If you insert a column those references inside the code wont change but the position on the worksheet will breaking your code. It depends where you insert that column as to what code needs to change. It is best not to insert a column but if you do need additional columns to add them after the last used column. If they do need to be inserted then you need to rewrite the code. In theory you could stop using absolute references such as Range("B1") and search for a header then use the headers column number such as Cells(1,columnnumber) where columnnumber is a variable. Theres too much work here for me to rewrite it for you.
 

Temkox

New Member
Joined
Feb 8, 2021
Messages
12
Office Version
  1. 2019
Platform
  1. Windows
There are countless places in that code where you reference a cell or cells. If you insert a column those references inside the code wont change but the position on the worksheet will breaking your code. It depends where you insert that column as to what code needs to change. It is best not to insert a column but if you do need additional columns to add them after the last used column. If they do need to be inserted then you need to rewrite the code. In theory you could stop using absolute references such as Range("B1") and search for a header then use the headers column number such as Cells(1,columnnumber) where columnnumber is a variable. Theres too much work here for me to rewrite it for you.
Thanks! Ill try to do that
 

Watch MrExcel Video

Forum statistics

Threads
1,128,129
Messages
5,628,869
Members
416,347
Latest member
AT2021

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
Top