Excel VBA – Set Column Width Exactly the Same in Other Workbooks – How to Code Examples
This Excel macro is useful if you have one or more Excel files where you want to set the column sizes exactly the same as the other workbook.
This script will take the current active (selected) workbook (Excel File) as a reference, get all the column widths from the active sheet (selected tab) and apply exactly the same widths to the active sheets (selected tabs) on all the other open workbooks (Excel files).
This VBA code will only affect active sheets.
Don’t forget to like and share if you found the code useful!
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
Sub MatchColumWidth() 'Set column widths of all the other open workbooks to the same size as the current one 'This script will only affect active sheets 'http://www.houstoncomputerclasses.com/ 'Chi Brander, Inc. '11/29/2016 abookm = ActiveWorkbook.Name For Each wb In Application.Workbooks If wb.Name <> abookm Then For Each c In Workbooks(abookm).ActiveSheet.Columns wb.ActiveSheet.Columns(c.Column).ColumnWidth = c.ColumnWidth Next c End If Next wb MsgBox "Done." End Sub |
Posted by Excel Instructor:
Excel VBA – Combine Many Tabs to One Master Worksheet – How to Code Examples
Suppose you have an Excel file with multiple tabs in the following format and you need to combine them to a single master sheet. This can either be a very long and boring copy/paste work or you can speed up the process by using the VBA code further down on this page.
| A | B | C | |
| 1 | Date | Account | Amount |
| 2 | 1/1/2016 | 484194 | $18,006.00 |
| 3 | 1/5/2016 | 497074 | $37,865.00 |
| 4 | 1/9/2016 | 321592 | $19,426.00 |
| 5 | 1/13/2016 | 784416 | $37,348.00 |
| 6 | 1/17/2016 | 904154 | $3,394.00 |
| 7 | 1/21/2016 | 936320 | $25,869.00 |
| 8 | 1/25/2016 | 596282 | $46,453.00 |
| 9 | 1/29/2016 | 257233 | $8,262.00 |
| 10 | 2/2/2016 | 640688 | $20,651.00 |
| 11 | 2/6/2016 | 169251 | $2,652.00 |
| 12 | 2/10/2016 | 204842 | $19,168.00 |
| 13 | 2/14/2016 | 403114 | $38,061.00 |
| 14 | 2/18/2016 | 932651 | $30,586.00 |
| Tab1 | |||
Don’t forget to like and share if you found the code useful!
|
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 |
Sub Combine_All_Tabs_to_Master_Sheet() 'http://www.houstoncomputerclasses.com/ '11/28/2016 'Chi Brander, Inc. st = Application.InputBox("Please, enter a valid master worksheet name") If Len(st) < 32 Then mname = st & "" Worksheets.Add.Name = mname For Each ws In Worksheets If ws.Name <> mname Then ws.Select If Range("A1").CurrentRegion.Rows.Count > 1 Then Range("A1").CurrentRegion.Offset(1, 0).Select Selection.Resize(Selection.Rows.Count - 1).Copy Worksheets(mname).Select Cells(Worksheets(mname).Range("a1").CurrentRegion.Rows.Count + 1, 1).Select ActiveSheet.Paste End If End If Next ws End If End Sub |
Posted by Excel Instructor:
VBA – Run a PowerPoint Macro using Excel VBA – How to Code Examples
Below is a demonstration of using PowerPoint.Application to open a PowerPoint file and then run a macro that is stored within the PowerPoint file.
- Make sure you modify “fullpath\p1.pptm” and point it to the full path-filename to your PowerPoint file.
- Modify the macro name. Macro name must be full macro name with file, module and macro name in your PowerPoint file in order for this script to work. Use the following format “p1.pptm!Module1.name”
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
Sub RunPowerPointMacro() Dim objPP As Object Dim objPPFile As Object Set objPP = CreateObject("PowerPoint.Application") objPP.Visible = True Set objPPFile = objPP.Presentations.Open("fullpath\p1.pptm") Application.EnableEvents = False objPP.Run "p1.pptm!Module1.name" Application.EnableEvents = True objPPFile.Close Set objPPFile = Nothing Set objPP = Nothing End Sub |
Posted by Excel Instructor:
VBA – Display a File Open Dialog and Open the File – Excel functions
Below is a demonstration of using Application.FileDialog to give the user an option to select a file and then open it. The code is well commented and should be self explanatory.
The full file path will be stored in fullpath variable, which is used later in the code to open the file after making sure there was an Excel file selected.
|
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 |
Sub FileOpenDialogBox() 'Display a Dialog Box that allows to select a single file. 'The path for the file picked will be stored in fullpath variable With Application.FileDialog(msoFileDialogFilePicker) 'Makes sure the user can select only one file .AllowMultiSelect = False 'Filter to just the following types of files to narrow down selection options .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1 'Show the dialog box .Show 'Store in fullpath variable fullpath = .SelectedItems.Item(1) End With 'It's a good idea to still check if the file type selected is accurate. 'Quit the procedure if the user didn't select the type of file we need. If InStr(fullpath, ".xls") = 0 Then Exit Sub End If 'Open the file selected by the user Workbooks.Open fullpath End Sub |
Posted by Excel Instructor:
VBA – Display a File Open Dialog Box For the User to Select a File – Excel functions
Below is a demonstration of using Application.FileDialog to give the user an option to select a file. The code is well commented and should be self explanatory.
The full file path will be stored in fullpath variable, which can be used later in the code.
An example using the code to prompt the user to select an Excel file an open it in Excel can be found here http://www.houstoncomputerclasses.com/excel-vba-display-a-file-open-dialog-and-open-the-file-excel-functions/
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
Sub FileOpenDialogBox() 'Display a Dialog Box that allows to select a single file. 'The path for the file picked will be stored in fullpath variable With Application.FileDialog(msoFileDialogFilePicker) 'Makes sure the user can select only one file .AllowMultiSelect = False 'Filter to just the following types of files to narrow down selection options .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1 'Show the dialog box .Show 'Store in fullpath variable fullpath = .SelectedItems.Item(1) End With End Sub |
Posted by Excel Instructor:
Excel VBA Function to SUM Unique Numbers Only – Unique SUMIF Function
First add this code to your VBA Function
|
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 |
Function SUMIFUNIQUENUMS(rng2 As Range, rng1 As Range, rng3 As Range) num = rng1.Count - 1 Dim arr1() As Variant ReDim arr1(num) i = 0 For Each r In rng1 If r.Value = rng3.Value Then arr1(i) = 1 * rng2(i + 1) Else arr1(i) = 0 End If i = i + 1 Next r Dim arr As New Collection, a On Error Resume Next For Each a In arr1 arr.Add a, Str(a) Next insum = 0 For Each n In arr insum = insum + n Next n SUMIFUNIQUENUMS = insum End Function |
Then use it in your worksheet like this
| A | B | C | D | E | |
| 1 | CA | 11 | CA | =SUMIFUNIQUENUMS($B$1:$B$7,$A$1:$A$7,D1) | |
| 2 | NY | 14 | NY | 29 | |
| 3 | NY | 15 | IN | 0 | |
| 4 | CA | 11 | |||
| 5 | CA | 11 | |||
| 6 | CA | 14 | |||
| 7 | CA | 11 | |||
| Sheet1 | |||||
Posted by Excel Instructor:
http://www.houstoncomputerclasses.com/excel-classes/
VBA – Check Regular & Overtime Hours – Excel functions
Below are 2 Excel VBA UDFs to check and divide regular and overtime hours based on 40 hour week, Monday through Friday Payroll.
| Date | Hours Worked | Regular | Overtime |
| 12/15/15 | 14 | 14 | 0 |
| 12/16/15 | 9 | 9 | 0 |
| 12/17/15 | 11 | 11 | 0 |
| 12/18/15 | 9 | 6 | 3 |
| 12/19/15 | 7 | 0 | 7 |
| 12/20/15 | 8 | 0 | 8 |
| 12/21/15 | 5 | 5 | 0 |
| 12/22/15 | 2 | 2 | 0 |
| 12/23/15 | 1 | 1 | 0 |
| 12/24/15 | 1 | 1 | 0 |
| 12/25/15 | 6 | 6 | 0 |
| 12/26/15 | 7 | 7 | 0 |
| 12/27/15 | 14 | 14 | 0 |
| 12/28/15 | 9 | 9 | 0 |
| 12/29/15 | 9 | 9 | 0 |
| 12/30/15 | 9 | 9 | 0 |
| 12/31/15 | 9 | 9 | 0 |
| 1/1/16 | 8 | 4 | 4 |
| 1/2/16 | 9 | 0 | 9 |
| 1/3/16 | 13 | 0 | 13 |
| 1/4/16 | 15 | 15 | 0 |
| 1/5/16 | 10 | 10 | 0 |
|
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 |
Public Function REG(datecol As Range, hourscol As Range) hrs = 0 For i = 2 To datecol.Row dt = Application.WeekNum(Cells(i, datecol.Column), 2) cdt = Application.WeekNum(Cells(datecol.Row, datecol.Column), 2) If dt = 53 Then dt = 1 End If If cdt = 53 Then cdt = 1 End If If cdt = dt Then hrs = hrs + Cells(i, hourscol.Column).Value End If If hrs <= 40 Then REG = Cells(datecol.Row, hourscol.Column) Else If (40 - (hrs - Cells(datecol.Row, hourscol.Column))) > 0 Then REG = 40 - (hrs - Cells(datecol.Row, hourscol.Column)) Else REG = 0 End If End If Next i End Function Public Function OVT(datecol As Range, hourscol As Range) hrs = 0 For i = 2 To datecol.Row dt = Application.WeekNum(Cells(i, datecol.Column), 2) cdt = Application.WeekNum(Cells(datecol.Row, datecol.Column), 2) If dt = 53 Then dt = 1 End If If cdt = 53 Then cdt = 1 End If If cdt = dt Then hrs = hrs + Cells(i, hourscol.Column).Value End If If hrs > 40 Then If (hrs - Cells(datecol.Row, hourscol.Column)) > 40 Then OVT = Cells(datecol.Row, hourscol.Column) Else OVT = hrs - 40 End If Else OVT = 0 End If Next i End Function |
Posted by Excel Instructor:
http://www.houstoncomputerclasses.com/excel-classes/
VBA – Unique List of Data That Appears At Least Once in All Columns – Excel Macro
Use this VBA code to extract a unique list of items that appear inside of multi-column data. The criteria is that the data needs to appear at least once in each column. This one has user friendly interface to run on any size data and get the results wherever user picks in the worksheet.
|
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 |
Sub UniqueListMatchingMultipleColumns() Dim rng As Range Dim srcrng As Range Set rng = Range("g1") Set srcrng = Application.InputBox("Please select you data (Do not include column headings!)", , , Type:=8) Set rng = Application.InputBox("Click the cell where you'd like the output to start rendering (a single cell):", , Type:=8) longstr = "||||" finalstring = "||||" For Each i In srcrng If InStr(longstr, "||||" & i.Value & "||||") = 0 Then longstr = longstr & i.Value & "||||" End If Next i For Each word In Split(Mid(longstr, 5, Len(longstr) - 8), "||||") n = 1 got = 0 For Each col In srcrng.Columns mt = Application.Match(word, srcrng.Columns(n), 0) If IsNumeric(mt) Then got = 1 Else got = 0 Exit For End If n = n + 1 Next col If got = 1 Then finalstring = finalstring & word & "||||" End If Next word r = 0 For Each finalword In Split(Mid(finalstring, 5, Len(longstr) - 8), "||||") rng.Offset(r, 0).Value = finalword r = r + 1 Next finalword End Sub |
Posted by Excel Instructor:
http://www.houstoncomputerclasses.com/excel-classes/
Call Us: (312) 818-5515
Average Salaries – City of Chicago Fire Police Department EarningsMarch 21, 2017 - 1:56 am- Average Salaries – City of Chicago Fire Department EarningsMarch 14, 2017 - 4:51 am
Ultimate Google Sheets VLOOKUP Tutorial SeriesMarch 14, 2017 - 4:44 am- Google Sheets SPLIT Function Tutorial – Similar to Text to Columns in ExcelMarch 5, 2017 - 11:46 am
How to Pull Data From Other SpreadSheets using Google Sheets IMPORTRANGE FunctionMarch 5, 2017 - 11:42 am
Locations Serving: Chicago, Loop, Downtown, North, North-East, North-West and West Suburbs, including Evanston, Northbrook, Schaumburg, Hoffman Estates and Naperville IL.