Microsoft Excel Spreadsheet Software Question

VBA to print non-contiguous columns in Excel worksheet

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

Trusted by Thousands of Top Companies

201410-LO-Qu-022

Related Questions We have nearly 4 million solutions here.

See More Microsoft Excel Spreadsheet Software Solutions

Solve Your Difficult Tech Problems Faster with Experts Exchange

Access millions of verified solutions and get 1-on-1 help from the experts.

Try It Free

30 day free trial.

Experts Exchange gives me a day to day reference of proven solutions that provide me guidance and troubleshooting help for my own clients.

- Brian B. Forte Consulting

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