Solved

AutoFit in Excel VBA.

Posted on 2001-07-23
11
2,777 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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
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…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…

911 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

19 Experts available now in Live!

Get 1:1 Help Now