Solved

AutoFit in Excel VBA.

Posted on 2001-07-23
11
2,812 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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
MS Dynamics Made Instantly Simpler

Make Your Microsoft Dynamics Investment Count  & Drastically Decrease Training Time by Providing Intuitive Step-By-Step WalkThru Tutorials.

 
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
 
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

Instantly Create Instructional Tutorials

Contextual Guidance at the moment of need helps your employees adopt to new software or processes instantly. Boost knowledge retention and employee engagement step-by-step with one easy solution.

Question has a verified solution.

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

Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
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…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

738 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