Home

Mr. Lee's Easy Excel Macros

Place Number Into an Excel Cell

Sub put_value_in_Cell ()
   myRow = 3  ' We put the row number, the columns number, and the sheet name into variables.
   myColumn = 7' Note that columns can be denoted by a number, with column A =1, Column B = 2 etc.
   myWorkSheet = "Sheet2"
   myNumber = 21'Next we put the number into our selected cell.
   Worksheets(my_workSheet).Cells(my_row, my_column).Value = my_number
End Sub

Place Text Into an Excel Cell

Sub string_Fu_Example ()
    mystring = "Hello. I am your friendly string! A string is just text."
    Worksheets("Sheet1").Cells(1, 1).Value = mystring
'Puts the string/text into the cell at row 1 ,column 1 within the first worksheet. 
End Sub

Move Data in Separate Columns to One Column

Take Excel data that is in a contiguous set of columns and rows, say columns A through E, with five rows each, and then move them into one single column, by stacking them ontop of each other.

Sub move()
   movecount = 0 'initialize variable
   firstrow = 1  'change these to your paricular situation
   lastrow = 5
   firstcol = 1
   lastcol = 5
   For Rows = firstrow To lastrow
      For Column = firstcol To lastcol
       movecount = movecount + 1 'change to your starting row # of the output
       Worksheets("Sheet1").Cells(movecount, 10).Value = Worksheets("Sheet1").Cells(Rows,Column).Value
      Next Column
   Next Rows
End Sub

Run Macro Upon Opening File

Place this macro code in ThisWorkbook, rather than the usual module.

Private Sub Workbook_Open()
	'Put rest of macro here: The code you want here. For example:
  	MsgBox("You Opened this File.")
End Sub

Open Multiple Excel Files in a Macro

Sub openMultipleExcelfiles()
  With Application.FileSearch
    .NewSearch
    .LookIn = "C:\myExcelData\"  'Set to the directory you want
    .SearchSubFolders = False
    .Filename = "*.xls" 'The * is a wild card. .xls is the file extension for excel files
    .Execute 'executes search
    For Each var_FileName In .FoundFiles
     Application.Workbooks.Open Filename:=var_FileName, ReadOnly:=True'Set true to save changes.
 Put rest of macro here.
     ActiveWorkbook.Close False 'Set true to save changes.
    Next
  End With
End Sub

More examples of techniques to open multiple files can be founf here: Open Multiple Excel files Page

Import Data into Excel with a Macro

Tired of manually importing data over and over? Use a Macro and automate it. You can record one and then shape to your needs, or customize this one.

Also note, that you can integrate this code into the Open Multiple Excel Files Macro presented on this page to automate multiple imports.

Sub Importdata()
	 With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\MyDataFolder\mydatafile.txt" _
        , Destination:=Range("A1"))
        .Name = "mydatafile.txt"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Pop-up Window to Enter Data: InputBox

Sub Input_text()
    myName = Application.InputBox("Enter your name", Type:=2)
  'The variable myName now contains the name the user inputs. 
  'Type:=2 means the user is entering a string. Use =1 for numbers, =4 for entering logical values
End Sub

Pop-up Message: MsgBox

Sub Input_text()
	myanswer = 7'This is just an example variable you want to display
    MsgBox("Tell your users something" & myanswer)
  'Some text and the variable myanswer is now displayed to the screen in a pop-up box
End Sub

Automatically Run a Macro When Workbook is Opened

Sub Auto_Open()
    'Put your macro Here.
End Sub

Find Duplicate Cells in a Workbook

This macro finds duplicates and highlights them with bold font.

Sub find_Duplicates()
On Error Resume Next
Dim myRange As Range
Dim aCell As Range
With Application.ReplaceFormat.Font
    .FontStyle = "Bold"
    .Subscript = False
End With
Set myRange = ActiveSheet.UsedRange
For Each aCell In myRange
    If (aCell.Font.Bold = False) And (IsEmpty(aCell) = False) Then 'check for duplicates
        If WorksheetFunction.CountIf(Cells, aCell.Value) > 1 Then 'there are duplicates
            Cells.Replace What:=aCell.Value, Replacement:=aCell.Value, LookAt:=xlPart, SearchOrder _
            :=xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
        End If 'end if
    End If
Next aCell
End Sub

Reports Number of Rows and Columns are Used in the Excel WorkSheet

Sub howmanycolumnsandrows()
    On Error Resume Next
    enderC = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
    enderR = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    MsgBox ("Your data is contained between row 1 and row " & enderR & vbCrLf _
    & "Your data is contained between column 1 and column " & enderC)
End Sub

Remove Empty Cells in Each Row

Sub removespaces_ineach_row()
    Cells.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
End Sub

Remove Empty Cells in Each Column

Sub removespaces_ineach_column()
    Cells.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End Sub

Remove Empty Cells in Each Column and Row

Sub removespaces_ineach_rowANDcolumn()
    Cells.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    Cells.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
End Sub

Loop Through Worksheets in a Workbook

Sub loopthruworksheets()
    For curSheet = 1 To Worksheets.Count
        Worksheets(curSheet).Select
        Selection.Activate
        'Now put the rest of your macro here to do
        'something with each Excel worksheet.
    Next curSheet
End Sub

Mr. Lee