excelvba

Code inserting and copying to the wrong worksheet


Each time I run this code it moves and inserts the columns to sheet1 starting at column "A". I am completely stumped as to the why. Would adding a line limiting this to the ThisWorkbook.Worksheet fix the issue?

Sub ArrangeCoreColumns()
    Dim ColOrder As Variant, idx As Integer
    Dim Fnd    As Range, count As Integer
    
        ColOrder = Array("route", "vrId", "carrier", "trailerNumber", "scheduledDepartureTime", "trailerId", "sealId", "label")
        count = 1
    
    Application.ScreenUpdating = False
    
    With Sheet8
        
        For idx = LBound(ColOrder) To UBound(ColOrder)
            Set Fnd = .Rows("1:1").Find(ColOrder(idx), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
            If Not Fnd Is Nothing Then
                If Fnd.Column <> count Then
                    Fnd.EntireColumn.Cut
                    Columns(count).Insert shift:=xlToRight
                    Application.CutCopyMode = False
                End If
                count = count + 1
            End If
        Next idx
    End With
    
    With Sheet8
        .Range("A1").value = "Lane"
        .Range("B1").value = "VRID"
        .Range("C1").value = "Carrier"
        .Columns("D:D").Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("D1").value = "Trailer #"
        .Range("F1").value = "SDT"
        .Range("G1").value = "Trailer ID"
        .Range("H1").value = "Seal #"
        .Range("I1").value = "Dock Door"
    End With
    
    With Sheet8
        .Range("D2").Formula = "=IFERROR(REPLACE(E2,1,FIND(""AZNG "",E2)+4,),"""")"
    End With
    
    With Sheet8
        '.Range("D2").AutoFill Destination:=Range("D2:D500")
        .Range("D2").Copy Destination:=.Range("D3:D500")
        .Range("A:I").Columns.AutoFit
    End With
    
    Application.ScreenUpdating = True
    
    Call TM_Formulas
    
End Sub

Solution

  • You seem to be missing . from Columns(count).Insert shift:=xlToRight. You could also remove redundant With statements to make it more readable:

    Sub ArrangeCoreColumns()
        Dim ColOrder As Variant, idx As Integer
        Dim Fnd As Range, count As Integer
        Dim ws As Worksheet
        
        ColOrder = Array("route", "vrId", "carrier", "trailerNumber", "scheduledDepartureTime", "trailerId", "sealId", "label")
        count = 1
        Set ws = Sheet8
        
        Application.ScreenUpdating = False
        
        With ws
            For idx = LBound(ColOrder) To UBound(ColOrder)
                Set Fnd = .Rows("1:1").Find(ColOrder(idx), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
                If Not Fnd Is Nothing Then
                    If Fnd.Column <> count Then
                        Fnd.EntireColumn.Cut
                        .Columns(count).Insert shift:=xlToRight
                        Application.CutCopyMode = False
                    End If
                    count = count + 1
                End If
            Next idx
            
            .Range("A1").Value = "Lane"
            .Range("B1").Value = "VRID"
            .Range("C1").Value = "Carrier"
            .Columns("D:D").Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            .Range("D1").Value = "Trailer #"
            .Range("F1").Value = "SDT"
            .Range("G1").Value = "Trailer ID"
            .Range("H1").Value = "Seal #"
            .Range("I1").Value = "Dock Door"
            
            .Range("D2").Formula = "=IFERROR(REPLACE(E2,1,FIND(""AZNG "",E2)+4,),"""")"
            .Range("D2").Copy Destination:=.Range("D3:D500")
            .Range("A:I").Columns.AutoFit
        End With
        
        Application.ScreenUpdating = True
        
        Call TM_Formulas
    End Sub