Solved

AutoFit in Excel VBA.

Posted on 2001-07-23
11
2,767 Views
Last Modified: 2012-08-14
How do I code an AutoFit for all the columns of a spreadsheet in Excel VBA?
0
Comment
Question by:arichee
11 Comments
 
LVL 12

Expert Comment

by:jgv
ID: 6309655
Something like this?

Cells.Select
Selection.Columns.AutoFit
0
 
LVL 8

Expert Comment

by:Dave_Greene
ID: 6309658
Set excel = CreateObject("Excel.Application")
excel.Workbooks.Add
Set worksheet = excel.workbooks(1).worksheets(1)
Set cells = worksheet.cells
' Autosize columns to their contents, and show the application    
worksheet.columns.AutoFit
excel.visible = true
0
 
LVL 8

Expert Comment

by:Dave_Greene
ID: 6309670
Here is an example using a range of cells

Option Explicit
   
   Private Sub Command1_Click()
      Dim oXL As Excel.Application
      Dim oWB As Excel.Workbook
      Dim oSheet As Excel.Worksheet
      Dim oRng As Excel.Range
     

      'On Error GoTo Err_Handler
     
   ' Start Excel and get Application object.
      Set oXL = CreateObject("Excel.Application")
      oXL.Visible = True
     
   ' Get a new workbook.
      Set oWB = oXL.Workbooks.Add
      Set oSheet = oWB.ActiveSheet
     
   ' Add table headers going cell by cell.
      oSheet.Cells(1, 1).Value = "First Name"
      oSheet.Cells(1, 2).Value = "Last Name"
      oSheet.Cells(1, 3).Value = "Full Name"
      oSheet.Cells(1, 4).Value = "Salary"
     

   ' Format A1:D1 as bold, vertical alignment = center.
      With oSheet.Range("A1", "D1")
         .Font.Bold = True
         .VerticalAlignment = xlVAlignCenter
      End With
     
   ' Create an array to set multiple values at once.
      Dim saNames(5, 2) As String
      saNames(0, 0) = "John"
      saNames(0, 1) = "Smith"
      saNames(1, 0) = "Tom"
      saNames(1, 1) = "Brown"
      saNames(2, 0) = "Sue"
      saNames(2, 1) = "Thomas"
      saNames(3, 0) = "Jane"

      saNames(3, 1) = "Jones"
      saNames(4, 0) = "Adam"
      saNames(4, 1) = "Johnson"
     
    ' Fill A2:B6 with an array of values (First and Last Names).
      oSheet.Range("A2", "B6").Value = saNames
     
    ' Fill C2:C6 with a relative formula (=A2 & " " & B2).
      Set oRng = oSheet.Range("C2", "C6")
      oRng.Formula = "=A2 & "" "" & B2"
     
    ' Fill D2:D6 with a formula(=RAND()*100000) and apply format.
      Set oRng = oSheet.Range("D2", "D6")
      oRng.Formula = "=RAND()*100000"
      oRng.NumberFormat = "$0.00"
     
    ' AutoFit columns A:D.
      Set oRng = oSheet.Range("A1", "D1")
      oRng.EntireColumn.AutoFit
     
    ' Manipulate a variable number of columns for Quarterly Sales Data.
      Call DisplayQuarterlySales(oSheet)
     
    ' Make sure Excel is visible and give the user control
    ' of Microsoft Excel's lifetime.
      oXL.Visible = True
      oXL.UserControl = True
     
    ' Make sure you release object references.
      Set oRng = Nothing
      Set oSheet = Nothing
      Set oWB = Nothing
      Set oXL = Nothing
     
   Exit Sub
   Err_Handler:
      MsgBox Err.Description, vbCritical, "Error: " & Err.Number
   End Sub
   
   Private Sub DisplayQuarterlySales(oWS As Excel.Worksheet)
      Dim oResizeRange As Excel.Range
      Dim oChart As Excel.Chart
      Dim iNumQtrs As Integer
      Dim sMsg As String
      Dim iRet As Integer
     
    ' Determine how many quarters to display data for.
      For iNumQtrs = 4 To 2 Step -1
         sMsg = "Enter sales data for" & Str(iNumQtrs) & " quarter(s)?"
         iRet = MsgBox(sMsg, vbYesNo Or vbQuestion _
            Or vbMsgBoxSetForeground, "Quarterly Sales")
         If iRet = vbYes Then Exit For
      Next iNumQtrs
     

      sMsg = "Displaying data for" & Str(iNumQtrs) & " quarter(s)."
      MsgBox sMsg, vbMsgBoxSetForeground, "Quarterly Sales"
     
    ' Starting at E1, fill headers for the number of columns selected.
      Set oResizeRange = oWS.Range("E1", "E1").Resize(ColumnSize:=iNumQtrs)

      oResizeRange.Formula = "=""Q"" & COLUMN()-4 & CHAR(10) & ""Sales"""
     
    ' Change the Orientation and WrapText properties for the headers.
      oResizeRange.Orientation = 38
      oResizeRange.WrapText = True
     
    ' Fill the interior color of the headers.
      oResizeRange.Interior.ColorIndex = 36
     
    ' Fill the columns with a formula and apply a number format.
      Set oResizeRange = oWS.Range("E2", "E6").Resize(ColumnSize:=iNumQtrs)
      oResizeRange.Formula = "=RAND()*100"
      oResizeRange.NumberFormat = "$0.00"
     
    ' Apply borders to the Sales data and headers.
      Set oResizeRange = oWS.Range("E1", "E6").Resize(ColumnSize:=iNumQtrs)
      oResizeRange.Borders.Weight = xlThin
     
    ' Add a Totals formula for the sales data and apply a border.
      Set oResizeRange = oWS.Range("E8", "E8").Resize(ColumnSize:=iNumQtrs)
      oResizeRange.Formula = "=SUM(E2:E6)"
      With oResizeRange.Borders(xlEdgeBottom)
         .LineStyle = xlDouble
         .Weight = xlThick
      End With
     
    ' Add a Chart for the selected data
      Set oResizeRange = oWS.Range("E2:E6").Resize(ColumnSize:=iNumQtrs)
      Set oChart = oWS.Parent.Charts.Add
      With oChart
         .ChartWizard oResizeRange, xl3DColumn, , xlColumns
         .SeriesCollection(1).XValues = oWS.Range("A2", "A6")
            For iRet = 1 To iNumQtrs
               .SeriesCollection(iRet).Name = "=""Q" & Str(iRet) & """"
            Next iRet
         .Location xlLocationAsObject, oWS.Name
      End With
     
    ' Move the chart so as not to cover your data.
      With oWS.Shapes("Chart 1")
         .Top = oWS.Rows(10).Top
         .Left = oWS.Columns(2).Left

      End With
     
    ' Free any references.
      Set oChart = Nothing
      Set oResizeRange = Nothing
   
   End Sub
 
0
 
LVL 3

Expert Comment

by:DrMaltz
ID: 6309754
arichee..


Sheet1.Select
Sheet1.Columns.AutoFit

Good Luck..
0
 

Author Comment

by:arichee
ID: 6309802
I tried the below with no luck, which adds a text-tab-delimited file to a workbook and saves it.  Any suggestions?

Dim Excel As New Excel.Application

Excel.Workbooks.Open "c:\test\test.txt"
Excel.Cells.Select
Excel.Columns.AutoFit
Excel.SaveWorkspace "c:\test\test.xls"
Excel.Workbooks.Close
Excel.Quit
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 8

Expert Comment

by:Dave_Greene
ID: 6309894
How about Adding...\

Dim oSheet As Excel.Worksheet
Dim oRng As Excel.Range

Set oSheet = Excel.ActiveSheet
Set oRng = oSheet.Range("A1", "Z1")
oRng.EntireColumn.AutoFit
0
 

Author Comment

by:arichee
ID: 6313779
Dave, I'm not sure how to fit my code into yours.
0
 
LVL 8

Expert Comment

by:Dave_Greene
ID: 6313877
Post what you have so far
0
 

Author Comment

by:arichee
ID: 6314584
The below annoyingly prompts me twice to save test.txt, and AutoFit didn't take in test.xls.

Dim Excel As New Excel.Application
Dim oSheet As Excel.Worksheet
Dim oRng As Excel.Range
 
Excel.Workbooks.Open "c:\test.txt"

Set oSheet = Excel.ActiveSheet
Set oRng = oSheet.Range("A1", "Z1")
oRng.EntireColumn.AutoFit
 
Excel.SaveWorkspace "c:\test.xls"
Excel.Workbooks.Close
Excel.Quit
0
 
LVL 8

Accepted Solution

by:
Dave_Greene earned 100 total points
ID: 6314729
Here ya go!

Dim Excel As New Excel.Application
  Dim oSheet As Excel.Worksheet
  Dim oRng As Excel.Range
   
  Excel.Workbooks.OpenText "c:\file.txt"
 
  Set oSheet = Excel.ActiveSheet
  Set oRng = oSheet.Range("A1", "Z1")
  oRng.EntireColumn.AutoFit
  Excel.ActiveWorkbook.RefreshAll
   
  Excel.ActiveWorkbook.SaveAs "c:\test.xls", FileFormat:=xlNormal
  Excel.Quit
0
 

Author Comment

by:arichee
ID: 6314774
Thanks!!!
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now