Question

VBA to print non-contiguous columns in Excel worksheet

Asked by: OGSan
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

This question has been solved and asker verified All Experts Exchange premium technology solutions are available to subscription members.

Subscribe now for full access to Experts Exchange and get

Instant Access to this Solution

  • Plus...
  • 30 Day FREE access, no risk, no obligation
  • Collaborate with the world's top tech experts
  • Unlimited access to our exclusive solution database
  • Never be left without tech help again

Subscribe Now

Sign Up Now!
Asked On
2010-09-07 at 12:03:10ID: 26457025
Tags

VBA EXCEL print automation

Topic

Microsoft Excel Spreadsheet Software

Participating Experts
1
Points
500
Comments
12

Trusted by hundreds of thousands everyday for fast, accurate and reliable tech support.

Companies like CVS, Honeywell, Chevron, Toyoto, TriStar Pictures, the U.S. Army, and Accenture

Your Complete Technology Resource

900+ topic areas (and counting)

Related Solutions

  1. refer to a worksheet by reference in VBA
    I need to refer to an Excel worksheet by a double reference, not by name, in my VBA code. I have a user-defined function in VBA that references a sheet to return the correct value. I would like this reference to the sheet to be variable...
  2. Worksheet Template
    I have 1 workbook with 1 worksheet. I'll need to create new worksheets on that file every once in a while. I'd like to be able to do an "Insert --> Worksheet" with a worksheet template. For example. If column A1 is called M...
  3. Protecting worksheets
    I am trying to protect part of my worksheet so that the user may not be able to make updates to only those specific columns. However, when I successfully protected the worksheet with the appropriate settings (Format cells – check prote...
  4. worksheet excel 2003
    Ok I have the names of worksheets stored on a worksheet("storage") in columns based on a target number.let say the user activates a worksheet based on a target number(target1) on worksheet("storage") and changes the ...
  5. Base Worksheet and related properties would lik…
    Every month I get a spreadsheet that has basic information date/start time/end time/duration/notes. all data is in the one worksheet. I would like to be able to create multiple worksheets that have the same properties as the base work...
Tutorials are great ways to tackle hard problems!

Featured Articles

Read through articles written by top experts!

Get full access to the help you need.

Subscribe Now

30-day free trial. Register in 60 seconds.

The Latest Technology News and Tips

Your answer is only minutes away!

New Solutions Everyday

Because of our active community of experts, on average new questions receive their first comment in under 30 minutes.

Top MS Excel Questions

       

Hear What our Users are Saying

Members of the expert community talk about why the experience at Experts Exchange is different than what you will find anywhere else.

Try it out and discover for yourself.

Subscribe Now

30-day free trial. Register in 60 seconds.

20130221-EE-VQP-039

3 Ways to Join

30-Day Free Trial

Why Experts Exchange?

Trusted by 44 of the Top Fortune 50 Companies. Verizon, Bank of America, IBM, Windows, Dell, Target, Boeing, Comcast, AT&T

Why Experts Exchange?

The go-to tech resource for hundreds of thousands.

"With the help of Experts Exchange -- I have been able to meet my deadlines and produce effective products"

Jan Miller

"I just today started my third contract assignment which I attribute to the skills I am learning from other experts."

Robert Antonellis

"It's my sole resource as I'm kind of an MS Access loner at my company. It's like having colleagues available when I run out of my own steam."

Karen Ruskin

Why Experts Exchange?

50K Tech Experts available to help

Leew has been an expert here since 1997 and is a master at Windows 2000 and XP, hard drives/storage and Small Business Server.

lrmoore has been an expert here since 2000 and is a six-time Microsoft MVP with over 18 years experience in the networking industry.

angeliii has been an expert here since 2000 and is a Microsoft MVP for his work with MS SQL Server and Development

Why Experts Exchange?

3 Million+ Questions Solved

"The experts approach solutions with patience and innovative ideas, and ultimately I have my problem solved."

Gary Serkhoshian

"Most every situation is already posted and answered, a quick search usually gives a solution. EE is truly a bargain."

Bob Schatzman

"9 out of 10 times Experts Exchange has the accepted solution or an open discussion of the potential solutions to the problem."

Kenny Red

Why Experts Exchange?

Serving tech professionals since 1996.

At Experts Exchange, we treat each question as unique and deserving of an answer.

As one of the most enduring technology resources, our community knows the importance of helping each individual with their problem, no matter how complex or how simple. We're here to collaborate with you.

Business Account Plans