none
Insert Two Columns in a Existing VBA Code RRS feed

  • Question

  • Below is a code I got from www.excel4routine.com for FIFO. I need help inserting two columns, one between B and C and another between K and L. Both of these column headers I need to say ItemDesc.

    I tried putting this code in but got a error

     Columns("C:C").Insert Shift:=xlToRight, _
          CopyOrigin:=xlFormatFromLeftOrAbove

    Range("C1").Value="ItemDesc"

    Here is the code from the www.excel4routine.com

    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

    ' www.excel4routine.com
    ' ZKL
        Application.ScreenUpdating = False
        ActiveSheet.Unprotect

    '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 = "=SUMIF(LOG!A:A,K2,LOG!F:F)"
        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
                    'MsgBox cell.Address 'replace with yr code here
                    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:=xlFormulas, LookAt _
                                :=xlPart, 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:=xlFormulas, LookAt _
                                :=xlPart, 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 .Offset(, 5).Value > 0 Then
                                           
                                        If .Offset(, 5).Value >= x 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)
                                           
                                            .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
                                            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)
                                           
                                            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
                                   
                                    If x = 0 Then Exit For
                                   
                            End With
                           
                        Next i
                       
                       
                    End If
                End If
            Next cell
           
            'GoTo UPDATELOG ' Update those outstanding "insufficient stocks" that are just matched to LOG

            '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
            '''''If Not matched >= pending Then
                
              
            '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"
                    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:=xlFormulas, LookAt _
                        :=xlPart, 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:=xlFormulas, LookAt _
                        :=xlPart, 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 .Offset(, 5).Value > 0 Then
                                   
                                If .Offset(, 5).Value >= x 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)
                                   
                                    .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
                                    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)
                                   
                                    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
                           
                            If x = 0 Then Exit For
                           
                    End With
                   
                Next i
    NextIteration:
            Next j

            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
       
        ActiveSheet.Protect
        Application.ScreenUpdating = True
    End Sub

    Wednesday, April 4, 2018 7:05 PM

All replies

  • You should not have got an error with the code you have unless you have data in the far right of the worksheet that cannot be moved off the worksheet.

    Not sure if insert column between K and L is their column Id's before or after inserting the column between columns B and C.

    If it is the column Id's before inserting between columns B and C then insert the one's to the right first. However, if it is the Id's after inserting between B and C then perform the insert after inserting column C.

    Following where between K and L is identified before the insertion between B and C

        Columns("L").Insert Shift:=xlToRight, _
               CopyOrigin:=xlFormatFromLeftOrAbove
       
        Range("L1").Value = "ItemDesc"
       
        Columns("C").Insert Shift:=xlToRight, _
               CopyOrigin:=xlFormatFromLeftOrAbove
              
        Range("C1").Value = "ItemDesc"


    Regards, OssieMac

    Sunday, April 8, 2018 1:58 AM