VBA to print non-contiguous columns in Excel worksheet

    Question by:
    On

    Topics:

    Hi, Experts!
    I have a worksheet that Is the target of the code below.
    I need to print specific columns from this worksheet - and I don't know how.
    The worksheet columns I need to print out are columns A:B, D:I, O, V, and W.
    I would like to also use the file-name as the header in this printed listing if that is possible.
    Can an Expert help me out, please?
    Many thanks in advance.
    ' Open the Excel Spreadsheet
    Set objExcel = CreateObject("Excel.Application")
    Set objWorkbook = objExcel.Workbooks.Open("\\nfs1\dept\purchasing\_Reporting_Periodic\Annual_InventoryWorksheets\ZZ_COUNT_SHEET_NON_STAGING.xls")
    
    
    'Insert columns required for physical inventory of the items on this worksheet
    Dim variance_frmla
    Dim valuation_frmla
    Dim i 
    Dim rg 
    
    'Disable screenupdating so the code runs faster
    objExcel.ScreenUpdating = False
    
    'Insert column headers beginning in Cell V2 (V as in Victor)
    objExcel.Cells(2, 22).Value = "Notes"
    objExcel.Cells(2, 23).Value = "Count1"
    objExcel.Cells(2, 24).Value = "Variance1 [Count Qty] - [Count1]"
    objExcel.Cells(2, 25).Value = "Valuation1 [Variance1] X [Unit Cost]"
    objExcel.Cells(2, 26).Value = "Count2"
    objExcel.Cells(2, 27).Value = "Variance2 [Count Qty] - [Count2]"
    objExcel.Cells(2, 28).Value = "Valuation2 [Variance2] X [Unit Cost]"
    objExcel.Cells(2, 29).Value = "Count3"
    objExcel.Cells(2, 30).Value = "Variance3 [Count Qty] - [Count3]"
    objExcel.Cells(2, 31).Value = "Valuation3 [Variance3] X [Unit Cost]"
    
    'Apply formatting across the column headers Z2 to AI2
    With objExcel.ActiveSheet
    	Set rg = .Range("V2:AE2")
        rg.Interior.ColorIndex = 30
        rg.Font.ColorIndex = 44
        rg.Font.Bold = True
        rg.Font.Size = 8
        rg.NumberFormat = "general"
    End With
    
    'Insert the Variance & Valuation formulas into adjacent cells beginning with AA3
    With objExcel.ActiveSheet
        Set rg = .Range("W3")
    
    'Insert the Variance & Valuation formulas into adjacent cells beginning with AA3
            variance_frmla = "=IF(W3<>0,$P3-W3,0)"
            valuation_frmla = "=IF(W3<>0,($P3-W3)*$U3,0)"
    
            rg.Offset(0, 1).Formula = variance_frmla
            rg.Offset(0, 1).Copy
            rg.Offset(0, 4).PasteSpecial -4123 ' - 4123 = xlPasteFormulas
            rg.Offset(0, 7).PasteSpecial -4123
            rg.Offset(0, 2).Formula = valuation_frmla
            rg.Offset(0, 2).Copy
            rg.Offset(0, 5).PasteSpecial -4123
            rg.Offset(0, 8).PasteSpecial -4123
    End With
    
    'This copies the formula all the way down cols AA3, AD3, and AH3
    'and then replaces the formula result with the value only (like doing Paste Special --> Values)
    With objExcel.ActiveSheet
        Set rg = .Range("W3")
        Set rg = .Range(rg, .Cells(.Cells(.Rows.Count, 1).End(-4162).Row, rg.Column)) 'xLUp = -4162
    '    Debug.Print rg.Address
    
        With rg.Offset(0, -1).Resize(, 10)
            .FillDown
    '>>> OMIT    .Formula = .Value
        End With
    End With
     
    'Must turn screenupdating back on
    objExcel.ScreenUpdating = True
    
    
    ' Retrieve the separate Date components. 
    Dim TodayYYYY, TodayMM, TodayDD
    TodayYYYY = Year(Date) 
    TodayMM   = Month(Date) 
    TodayDD   = Day(Date) 
    
    ' Retrieve the IBU value from cell A3 for use in the file-name
    Dim IBU
    IBU = objExcel.Cells(3, 1).Value
    
    ' Save the sheet - appending TodaysDate to the end of the file-name.
    objWorkbook.SaveAs "\\nfs1\dept\purchasing\_Reporting_Periodic\Annual_InventoryWorksheets\ZZ_COUNT_SHEET_NON_STAGING_" & IBU & "_" & TodayYYYY & "-" & TodayMM & "-" & TodayDD & ".xls"
    
                                    
    1:
    2:
    3:
    4:
    5:
    6:
    7:
    8:
    9:
    10:
    11:
    12:
    13:
    14:
    15:
    16:
    17:
    18:
    19:
    20:
    21:
    22:
    23:
    24:
    25:
    26:
    27:
    28:
    29:
    30:
    31:
    32:
    33:
    34:
    35:
    36:
    37:
    38:
    39:
    40:
    41:
    42:
    43:
    44:
    45:
    46:
    47:
    48:
    49:
    50:
    51:
    52:
    53:
    54:
    55:
    56:
    57:
    58:
    59:
    60:
    61:
    62:
    63:
    64:
    65:
    66:
    67:
    68:
    69:
    70:
    71:
    72:
    73:
    74:
    75:
    76:
    77:
    78:
    79:
    80:
    81:
    82:
    83:
    

    Select allOpen in new window

     

    Verified Answer?

    The member who asked this question verified this comment provided the solution that solved their problem.

    by:Posted on 2010-09-07 at 14:45:41ID: 33622290

    use the following code.

    Note:
    If you want to print Colmn V after Coumn W, I can't think of a  smarter way other than moving column V to the right of Column W temporarily.

    I listed the sample code (along with the 'undo' piece, i.e. move coulmn V back to its original place after printing).

    'print landscape :
            objExcel.ActiveSheet.PageSetup.Orientation = xlLandscape
    
    
    'Autofit columns 
        objExcel.Cells.Select
        objExcel.Selection.Columns.AutoFit
    
    
    
    'Set column V's width to 2 Inches
        objExcel.Columns("V:V").Select
        objExcel.Selection.ColumnWidth = 26.71 '=192 pixels = 2 inches
    
    
    'To temporarily move column V after W 
        objExcel.Columns("V:V").Select
        objExcel.Selection.Cut
        objExcel.Columns("X:X").Select
        objExcel.Selection.Insert Shift:=xlToRight
    
    
    'To move coulmn V back to its original place after printing
        objExcel.Columns("W:W").Select
        objExcel.Selection.Cut
        objExcel.Columns("V:V").Select
        objExcel.Selection.Insert Shift:=xlToRight
                                              
    1:
    2:
    3:
    4:
    5:
    6:
    7:
    8:
    9:
    10:
    11:
    12:
    13:
    14:
    15:
    16:
    17:
    18:
    19:
    20:
    21:
    22:
    23:
    24:
    25:
    26:
    27:
    

    Select allOpen in new window

    This content is available to Experts Exchange members

    See the answer now
    with your Free 30 Day Trial

    Get unlimited access to solutions & experts

    • 4,169,477 solved questions
    • 3,805 articles & videos
    • 15,413 tech experts

    Get Access Now

    Ask Your Tech Question. Get Expert Solutions.We will email you when an expert has commented on your question.

    We will never share this with anyone. Privacy Policy Terms of Use

    Select topics

    You may select up to five topics.

    Top Expert Contributor

    Essential articles and videos from the Experts

    More valuable questions with Expert answers

    201507-LO-Qu-065