VBA to print non-contiguous columns in Excel worksheet

MS Excel Question

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

Default Text
 

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

Need a customized answer?
Ask your question for one-on-one assistance. 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.

201504-LO-Qu-066

Related Articles

Related Questions

Experts Exchange powers the growth and success
of technology professionals worldwide.

  • Solve

    Experts Exchange is the tech professional’s trusted, on-demand resource for solving difficult problems, making informed decisions, and delivering excellent solutions.

  • Learn

    With unparalleled access to technical experts, verified real-world solutions, and diverse educational content, Experts Exchange enables personalized development of technology skills.

  • Network

    Experts Exchange gives you the professional exposure and valued relationships key to building the career you want.

Join the Network Today

See Plans and Pricing