VBE - New Code Not Attaching to Target Workbook

Question

I am writing a macro that merges multiple forms into one and then adds a 'BeforeRightClick' method programmatically to the new combined file.

The code mostly works except instead of adding the code to the new workbook, it creates a ghost copy and adds the code to that. This ghost file doesn't seem to exist anywhere.

Issue example screenshot

I have tried forcing it to activate the workbook first and as attached, spliced the method straight into the main method. Nothing seems to work.

Notes:

The file format I use for these workbooks are XLSB
The source I used to make this is here:
The reference 'Microsoft Visual Basic for Applications Extensibility 5.3 library' is ticked.

Section of code in question:


    With New_WB
        Set xPro = .VBProject
        Set xCom = xPro.VBComponents(New_WB.Sheets("Reorder Level Form").CodeName)
        Set xMod = xCom.CodeModule
    
        With xMod
            xLine = .CreateEventProc("BeforeRightClick", "Worksheet")
            xLine = xLine + 1
            .InsertLines xLine, "  a = Cells(ActiveCell.Row, 22).Value"
            xLine = xLine + 1
            .InsertLines xLine, "  i = 1"
            xLine = xLine + 1
            .InsertLines xLine, "  For Each c In Selection"
            xLine = xLine + 1
            .InsertLines xLine, "      If Cells(c.Row, 22).Offset(0, -21).Value <> """" Then"
            xLine = xLine + 1
            .InsertLines xLine, "      With Cells(c.Row, 22)"
            xLine = xLine + 1
            .InsertLines xLine, "           Select Case a"
            xLine = xLine + 1
            .InsertLines xLine, "           Case False"
            xLine = xLine + 1
            .InsertLines xLine, "               .Value = True"
            xLine = xLine + 1
            .InsertLines xLine, "           Case Else"
            xLine = xLine + 1
            .InsertLines xLine, "              .Value = False"
            xLine = xLine + 1
            .InsertLines xLine, "           End Select"
            xLine = xLine + 1
            .InsertLines xLine, "      End With"
            xLine = xLine + 1
            .InsertLines xLine, "      End If"
            xLine = xLine + 1
            .InsertLines xLine, "  If i >= 1000 Then Exit Sub"
            xLine = xLine + 1
            .InsertLines xLine, "  i = i + 1"
            xLine = xLine + 1
            .InsertLines xLine, "  Next c"
            xLine = xLine + 1
            .InsertLines xLine, "  Cancel = True"
        End With
        With .Sheets("Reorder Level Form")
            .Columns("B:B").Delete Shift:=xlToLeft
            .Columns("D:F").ColumnWidth = 8
            .Columns("I:I").ColumnWidth = 6
            .Columns("K:K").ColumnWidth = 13
            .Columns("L:M").ColumnWidth = 9
            .Columns("N:P").ColumnWidth = 17
            .Columns("P:Q").ColumnWidth = 10
            .Columns("R:V").ColumnWidth = 12
            
            With .Rows("1:1")
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = True
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
                .RowHeight = 45
            End With
        End With
    End With

Full method:


    Sub Compiler()
    Dim Header() As Variant
    Dim Data() As Variant
    Dim ws As Worksheet
    Dim rngOutput As Range
    Dim xPro As VBIDE.VBProject
    Dim xCom As VBIDE.VBComponent
    Dim xMod As VBIDE.CodeModule
    Dim xLine As Long
    Dim strFilename As String
    
    strFilename = ThisWorkbook.Sheets("Settings").Range("B1").Value & "\Stock Level Converter\Stock Level Change Extract " & Format(Now, "dd-mm-yy hhmm") & ".xlsb"
    
    totWB = 0
    totWB = Count_WB
    n = 0
    Hd_Row = Head_Row
    
    Set New_WB = Workbooks.Add
    New_WB.SaveAs strFilename, FileFormat:=50
    
    dirWB = Dir(ThisWorkbook.Sheets("Settings").Range("B1").Value & "\Stock Level Converter\Import Files\")
    
    '--------------------------------------------------
    
    While dirWB <> ""
     
    'Opens current file for import and saves it as a back up
        Set External_WB = Workbooks.Open(ThisWorkbook.Sheets("Settings").Range("B1").Value & "\Stock Level Converter\Import Files\" & dirWB)
        ChkAutoSv
        strBackup = ThisWorkbook.Sheets("Settings").Range("B1").Value & "\Stock Level Converter\Import Back Ups\" & Format(Now, "yyyymmddhhmmss")
        External_WB.SaveAs strBackup, xlExcel12
    Deletes old copy
        Kill ThisWorkbook.Sheets("Settings").Range("B1").Value & "\Stock Level Converter\Import Files\" & dirWB
        frmMenu.lblStatus.Value = "Task: " & dirWB
        frmMenu.Repaint
        'DoEvents
        
        For Each External_WS In Worksheets
            If External_WS.Name = "Reorder Level Form" Then
            'If External_WS.Visible = xlSheetVisible Then"
    
                lst_Col = 27 'Last_Col 'the last used column in the current import file
                
                With External_WS
                    .Activate
                    If .Range("B1").Value <> "CONC" Then
                        .Columns("B:B").Insert Shift:=xlToLeft
                    End If
                    .Columns(27).EntireColumn.Insert Shift:=xlRight
                    .Cells(Hd_Row, 27).Value = "Store No."
                    .Cells.EntireColumn.Hidden = False
                    .Cells.EntireRow.Hidden = False
                    .Cells.UnMerge
                    For i = Hd_Row + 1 To Last_Row(1)
                        Cells(i, 27).Value = .Cells(2, 3).Value
                    Next i
                    'Assigns data in header row to array
                    Header = .Range(Cells(Hd_Row, 1), Cells(Hd_Row, 27)).Value2
                    'Assigns data to array
                    Data = .Range(Cells(Hd_Row + 1, 1), Cells(Last_Row(1), 27)).Value2
                
                End With
                
                'Checks sheet exists in new file
                If WorksheetExists(External_WS.Name) = False Then
                    'Worksheet does not exist in New File
                    'Create new sheet and name it.
                    New_WB.Sheets.Add.Name = External_WS.Name
                    'Paste header array to cell(1,1)
                    Set rngOutput = New_WB.Sheets(External_WS.Name).Range("A1")
                    rngOutput.Resize(UBound(Header, 1), UBound(Header, 2)) _
                    = Header
                End If
                'Paste Data to column A of last used row + 1
                r = Last_Row(2) + 1
                
                Set rngOutput = New_WB.Sheets(External_WS.Name).Cells(r, 1)
                
    
                rngOutput.Resize(UBound(Data, 1), UBound(Data, 2)) _
                = Data
                    
            End If
    
        Next External_WS
        
        With External_WB
            .Close SaveChanges:=False
        End With
    
        'DoEvents
        dirWB = Dir()
    Wend
        
    With New_WB
        Set xPro = .VBProject
        Set xCom = xPro.VBComponents(New_WB.Sheets("Reorder Level Form").CodeName)
        Set xMod = xCom.CodeModule
    
        With xMod
            xLine = .CreateEventProc("BeforeRightClick", "Worksheet")
            xLine = xLine + 1
            .InsertLines xLine, "  a = Cells(ActiveCell.Row, 22).Value"
            xLine = xLine + 1
            .InsertLines xLine, "  i = 1"
            xLine = xLine + 1
            .InsertLines xLine, "  For Each c In Selection"
            xLine = xLine + 1
            .InsertLines xLine, "      If Cells(c.Row, 22).Offset(0, -21).Value <> """" Then"
            xLine = xLine + 1
            .InsertLines xLine, "      With Cells(c.Row, 22)"
            xLine = xLine + 1
            .InsertLines xLine, "           Select Case a"
            xLine = xLine + 1
            .InsertLines xLine, "           Case False"
            xLine = xLine + 1
            .InsertLines xLine, "               .Value = True"
            xLine = xLine + 1
            .InsertLines xLine, "           Case Else"
            xLine = xLine + 1
            .InsertLines xLine, "              .Value = False"
            xLine = xLine + 1
            .InsertLines xLine, "           End Select"
            xLine = xLine + 1
            .InsertLines xLine, "      End With"
            xLine = xLine + 1
            .InsertLines xLine, "      End If"
            xLine = xLine + 1
            .InsertLines xLine, "  If i >= 1000 Then Exit Sub"
            xLine = xLine + 1
            .InsertLines xLine, "  i = i + 1"
            xLine = xLine + 1
            .InsertLines xLine, "  Next c"
            xLine = xLine + 1
            .InsertLines xLine, "  Cancel = True"
        End With
        With .Sheets("Reorder Level Form")
            .Columns("B:B").Delete Shift:=xlToLeft
            .Columns("D:F").ColumnWidth = 8
            .Columns("I:I").ColumnWidth = 6
            .Columns("K:K").ColumnWidth = 13
            .Columns("L:M").ColumnWidth = 9
            .Columns("N:P").ColumnWidth = 17
            .Columns("P:Q").ColumnWidth = 10
            .Columns("R:V").ColumnWidth = 12
            
            With .Rows("1:1")
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = True
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
                .RowHeight = 45
            End With
        End With
    End With
    
    New_WB.Save
    New_WB.Close , True
    
    ThisWorkbook.VBProject.VBE.MainWindow.Visible = False
    End Sub

Thanks in advance.

Thanks for testing it. It works when I debug through it, just not at runtime. I can't find anything on the internet that remotely matches the issue I'm having. — H Flintoft, Sep 04 '20 at 08:36
Possbile to zip couple of files so that I can run it at my end? — Siddharth Rout, Sep 04 '20 at 08:49
This line has "New_WB" in it when you already have it within a With statement.. Not sure if that could be causing the issue.. `Set xCom = xPro.VBComponents(New_WB.Sheets("Reorder Level Form").CodeName)` — Joey, Sep 04 '20 at 12:53
I tried to nest the with statements in an attempt to fix the issue. Originally this was in a separate module. — H Flintoft, Sep 04 '20 at 18:05
Files are here [link](https://drive.google.com/drive/folders/12CH_4GzW4SxyRI27tomibVceJBn1GMpi?usp=sharing) — H Flintoft, Sep 04 '20 at 21:16

VBE - New Code Not Attaching to Target Workbook

0 Answers0