arichee
asked on
AutoFit in Excel VBA.
How do I code an AutoFit for all the columns of a spreadsheet in Excel VBA?
Set excel = CreateObject("Excel.Applic ation")
excel.Workbooks.Add
Set worksheet = excel.workbooks(1).workshe ets(1)
Set cells = worksheet.cells
' Autosize columns to their contents, and show the application
worksheet.columns.AutoFit
excel.visible = true
excel.Workbooks.Add
Set worksheet = excel.workbooks(1).workshe
Set cells = worksheet.cells
' Autosize columns to their contents, and show the application
worksheet.columns.AutoFit
excel.visible = true
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.Applic ation")
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(oShe et)
' 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:=i NumQtrs)
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.Colo rIndex = 36
' Fill the columns with a formula and apply a number format.
Set oResizeRange = oWS.Range("E2", "E6").Resize(ColumnSize:=i NumQtrs)
oResizeRange.Formula = "=RAND()*100"
oResizeRange.NumberFormat = "$0.00"
' Apply borders to the Sales data and headers.
Set oResizeRange = oWS.Range("E1", "E6").Resize(ColumnSize:=i NumQtrs)
oResizeRange.Borders.Weigh t = xlThin
' Add a Totals formula for the sales data and apply a border.
Set oResizeRange = oWS.Range("E8", "E8").Resize(ColumnSize:=i NumQtrs)
oResizeRange.Formula = "=SUM(E2:E6)"
With oResizeRange.Borders(xlEdg eBottom)
.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).XValu es = oWS.Range("A2", "A6")
For iRet = 1 To iNumQtrs
.SeriesCollection(iRet).Na me = "=""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
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.Applic
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(oShe
' 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:=i
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.Colo
' Fill the columns with a formula and apply a number format.
Set oResizeRange = oWS.Range("E2", "E6").Resize(ColumnSize:=i
oResizeRange.Formula = "=RAND()*100"
oResizeRange.NumberFormat = "$0.00"
' Apply borders to the Sales data and headers.
Set oResizeRange = oWS.Range("E1", "E6").Resize(ColumnSize:=i
oResizeRange.Borders.Weigh
' Add a Totals formula for the sales data and apply a border.
Set oResizeRange = oWS.Range("E8", "E8").Resize(ColumnSize:=i
oResizeRange.Formula = "=SUM(E2:E6)"
With oResizeRange.Borders(xlEdg
.LineStyle = xlDouble
.Weight = xlThick
End With
' Add a Chart for the selected data
Set oResizeRange = oWS.Range("E2:E6").Resize(
Set oChart = oWS.Parent.Charts.Add
With oChart
.ChartWizard oResizeRange, xl3DColumn, , xlColumns
.SeriesCollection(1).XValu
For iRet = 1 To iNumQtrs
.SeriesCollection(iRet).Na
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
arichee..
Sheet1.Select
Sheet1.Columns.AutoFit
Good Luck..
Sheet1.Select
Sheet1.Columns.AutoFit
Good Luck..
ASKER
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
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
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
Dim oSheet As Excel.Worksheet
Dim oRng As Excel.Range
Set oSheet = Excel.ActiveSheet
Set oRng = oSheet.Range("A1", "Z1")
oRng.EntireColumn.AutoFit
ASKER
Dave, I'm not sure how to fit my code into yours.
Post what you have so far
ASKER
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
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks!!!
Cells.Select
Selection.Columns.AutoFit