Excel Tips

Complexity level from 1 to 5

level 4
Here I use variables to get the name of my files that I open in order to go to them later when I call them by the name of the variable. I also use this variable in the actual Vlookup. This way I don't have to hard code the file name and can tweak it later if needed.
Sub VlookupFile()
Dim step1Filename As Variant
Dim step1Tabname As Variant
Dim step1LookupFilename As Variant
Dim startingFilename As Variant
Dim tabName As String
Dim ws As Worksheet
Dim R As Variant
' Get the value in a variable of the current file name you are on to go to that later
startingFilename = ActiveWorkbook.Name
tabName = ActiveSheet.Name
step1Filename = Application.GetOpenFilename(Title:="Please select lookup file")
If step1Filename = False Then
    MsgBox "Stopping because you did not select a file"
Exit Sub
End If
Workbooks.OpenText FileName:=step1Filename
step1LookupFilename = ActiveWorkbook.Name ' dont need this one if not using the workbook name later
step1Tabname = ActiveSheet.Name ' dont need this one if not using the tab name later

' Now select the beginning file to do the lookup on
Range("F2").Value = "=VLOOKUP(B2,'" & step1Filename & "'!$A:$Q,5,FALSE)"
End Sub

Using VBA code to Communicate with Attachmate Mainframe System

level 5
Here I used VBA code to communicate with our mainframe system in order to either get information out of the system or to place information into the system. There are several ways to do these tasks. Information can be taken out or placed into the main system this way. Plus doing several calculation as well and placing it into a spreadsheet to analyze the date.
' Dim the sessions
Dim sys As Object
Dim session As Object
Dim curscreen As Object
Dim textVal as string
Set sys = CreateObject("Extra.System")
Set session = sys.ActiveSession
Set curscreen = session.screen
' You can use things like getString to pull information from the system
TextVal = curscreen.getString(rowCount, 23, 2)
' You can use putString to place things in the system
TextVal = curscreen.getString(rowCount, 23, 2)
' you can also output the information into a spreadsheet
ActiveCell.Offset(0, 0).Value = (textVal)
' Also you loops through the rows in the system.
getMessage = curscreen.getString(24, 22, 13)
    For rowCount = 9 To 20
        textVal = curscreen.getString(rowCount, 23, 2)
        If storeNum = "_______" Or DC = "__" Then Exit For
        ActiveCell.Offset(0, 0).Value = (DC)
    Next rowCount
    getMessage = curscreen.getString(24, 22, 13)
    If getMessage = "PF8 TO SCROLL" Then
        TextVal = curscreen.SendKeys("<PF8>")
        Do Until (curscreen.waitforcursor(3, 15)) ' Used to wait for location instead of using a timer delay
        Exit Do
    End If

Removing Spaces in a String using VBA

level 2
Here I use an input box not shown here to allow a user to input data. For this project I only had a limited amount of spaces so I needed to remove the spaces from the users input. That way the input was all together. I then save it using this new variable. Because the system I was placing it in on the web had limited characters.
Dim removeSpaces As String
Dim getInput As String
removeSpaces = Replace(getInput, " ", "")

Getting the Row and Column Location Value using VBA

level 1
Here I use this code to get the row and column location and then I evaluate that variable with an if statement if the main frame or another system is not moving to the correct location. I can then check that location and if the location is not right I can have the cursor screen or cell more to that location. If the location is correct I can have the code move on.
Dim getRow As String
Dim getColumn As String
getRow = ActiveCell.Row
getColumn = ActiveCell.Column

Common excel issues with a vlookup

level 1
Some of the common problems I hear people say to me with a vlookup is they cant get any results or the formula only shows and not any data. So the things that I have them check are: 1) I check to see if they are getting any results from the look up. For instance, if they are getting a zero then the data that the formula is returning does not have something in that cell. If they are getting a #N/A then the look up value is not found. 2) In excel options are formulas set to automatic calculation. 3) Are they looking from an older version to a newer version and not noticing that the vlookup formula is showing an invalid in the table array. 4) then I have them check to make sure they are not showing formulas which is formulas tab and then show formulas. 5) If these do not work I have them close out of excel and open it again and see if that fixes the issue.

Converting date format using VBA

level 3
Here I am getting the active cell date that is formatted 01/24/2015 and and pulling out the day and the month and the year. Reformatting it to be combined into a text format of 20150124 into an existing file. This code loops through the cells and places the newly converted date into the same cell and over writes the other date. In this example I did not show you my defined variables. However, in my actual project they are defined. The reason I coded it this way is it is used buy a lot of people and they did not want to change the current format from what they are using it for.
    ' Here I get the date from a cell
    convertMonth = ActiveCell.Offset(0, 0)
    ' here I use just the Month from that date
    newMonth = Month(convertMonth)
    ' Here I get the date from a cell
    convertDay = ActiveCell.Offset(0, 0)
    ' here I use just the Day from that date
    newDay = Day(convertDay)
    convertYear = Right(Left(ActiveCell.Offset(0, 0), 10), 4)
    ' Now I combine it together as a text format for a project i am working on.
    combinedDate = convertYear & newMonth & newDay
    ' Here I output it to the same see overwrithing the current date and format
    ActiveCell.Offset(0, 1).Value = (combinedDate)
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell = ""

Using VBA to do Randbetween, A random number

Level 3
Here I am using VBA to do a a similar function of randbetween. The reason for using VBA to produce these results instead of just using the formula is when any place on the sheet is edited or changed the number will change. However, using VBA to do this keeps the number the same until I run the macro again. I could also assign it to a button to make it easy to just click the button and run the code.
Sub UsingVBAforRandbetween()
Dim gp As Double
Dim gpFirst As Double
Dim gpLast As Double
Dim setGpRange As String
setGpRange = Range("B6")
gpFirst = Range("C6")
gpLast = Range("D6")
    If setGpRange = "y" Then
        If gpFirst >= 0 Then
           gp = Int((gpLast - gpFirst + 1) * Rnd + gpFirst)
           gp = 0
       End If
       gp = 0
    End If
Range("E6").Value = (gp)
End Sub

Emailing Code with VBA

Level 5
I created this code to attach different excel files that are in a projects directory to an email template. The email template has a paragraph or two of general information related to that customer. The file to be attached has an email address located in cell AC9. So the code opens up the file and gets the email address and places it into the template along with the excel file and sends the email off. When the email is sent it takes the file and moves it to a completed directory.
Sub AttachExcelFileToEmails()
Const strPath = "C:\Project\Data\"
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim current_file_name As String
    Dim strExtension As String
    Dim Email As String
    Dim Vend_Name As String
    Dim newLocation As String
    Dim wWB As Object
    Dim sPath As String
    Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
newLocation = ("C:\Project\Completed\")
ChDir strPath
sPath = "C:\Project\Data\"
sDir = Dir$(strPath & "*.xlsx", vbNormal)
    Do Until LenB(sDir) = 0
    Set wWB = Workbooks.Open(sPath & sDir)
        Application.Wait Now() + TimeValue("00:00:01")
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItemFromTemplate("C:\Project\Guide.oft")
        current_file_name = "C:\Project\Data\" & ActiveWorkbook.Name
        Email = Range("AC9")
        Vend_Name = Range("U9")
        On Error Resume Next
        With OutMail
            .To = Email
            .CC = ""
            .BCC = ""
            .Subject = "updated information-" & " " & Vend_Name & " Vender ID " & [A9]
        '    .HTMLBody = ""
            .Attachments.Add current_file_name
            .send   'or use .Display
        End With
        On Error GoTo 0
        ActiveWorkbook.Close SaveChanges = False
       sDir = Dir$
    fso.MoveFile current_file_name, newLocation
End Sub

Open Excel Workbook and validating data

Level 4
This code opens up every excel file in a specified folder and checks to see if I have a certain criteria in it. In this instance, I am looking at cell B16 to see if it is blank. If there is nothing in that cell then it closes the active workbook otherwise it leaves it opened.
Sub OpenAllFiles()
    Dim folderPath As String
    Dim fileName As String
    Dim WB As Workbook
    folderPath = "U:\Testing\" 'change to suit
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
    fileName = Dir(folderPath & "*.xls")
    Do While fileName <> ""
      Application.ScreenUpdating = False
        Set WB = Workbooks.Open(folderPath & fileName)
        'Call your subroutine here to operate on the just-opened workbook.
        'Here I just look at one cell in each spreadsheet to see if something is there. 
        'If there is nothing there then close it otherwise leave it opened.
        If Range("B16") = "" Then
        End If
        fileName = Dir
  Application.ScreenUpdating = True
  MsgBox ("All Done process the ones still opened!")
End Sub

Using arrays and adding totals

level 5
In this example, The code gets a little more complicated. I stripped out most of the code here and made it for one variable so it is easier for you to get the hang of it. With this example I needed a way to catch several different items with the totals and add them together with that same item. In order to do this without using an array I would have to create every variable for each one and would have been to time intensive and complicated.. This would be ok if there were only a couple dozen variables and they wouldn't change. However, for this project they would change. So I needed to use arrays. I needed to create an array that would go through about 5000 rows of data. Creating a variable for the item and for the total. I used an array to pull all my data in for this and then output it. Then all I had to do was to cycle it through and output the total. For the code that is posted here it just takes one variable into an array and outputs that total.
Sub ArrayAddingTotalsTogether()
Dim amountArray(1 To 100000) As Double
Dim lastRow As Integer
Dim lastCol As Integer
Dim Row_Counter As Integer
Dim Col_Counter As Integer
Dim Array_Counter As Integer
Dim colCount As Integer
Dim grandTotal As Double
Dim Total_Array As Integer
Array_Counter = 0
lastRow = ActiveSheet.UsedRange.Rows.count
lastCol = ActiveSheet.UsedRange.Columns.count
For Row_Counter = 0 To (lastRow - ActiveCell.row)
    If ActiveCell.Offset(Row_Counter, 0) <> "" Then
         Array_Counter = Array_Counter + 1
        amountArray(Array_Counter) = ActiveCell.Offset(Row_Counter, 5) ' Here is the starting column amount
    End If
Next Row_Counter
Total_Array = Array_Counter
For Array_Counter = 1 To Total_Array
    grandTotal = amountArray(Array_Counter) + grandTotal
Next Array_Counter
Range("H1").Value = "Grand Total"
Range("I1").Value = (grandTotal)
End Sub

Quick MPG using VBA

Level 2
This is a really simple code to use for figuring out miles per gallon cost for a trip.
Sub Millage_Per_Gallon()
    Dim MilesOneWay As Integer
    Dim CostPerTrip As Currency
    Dim MilesPerGallon As Integer
    Dim costOfGasPreGallon As Variant
    Dim userinput As Variant
    userinput = InputBox("Is this a round trip? y/n")
    If userinput = "n" Or userinput = "N" Then
        MilesOneWay = InputBox("How far is drive One Way? ie. 30")
        MilesPerGallon = InputBox("What is your current MPG? ie 21")
        costOfGasPreGallon = InputBox("What is the price of gas per gallon ie. 3.15?")
        CostPerTrip = (MilesOneWay / MilesPerGallon * costOfGasPreGallon)
         MsgBox "Gas Cost is $" & (CostPerTrip)
    End If
    If userinput = "y" Or userinput = "Y" Then
        MilesOneWay = InputBox("How far is drive One Way? ie. 30")
        MilesPerGallon = InputBox("What is your current MPG? ie 21")
        costOfGasPreGallon = InputBox("What is the price of gas per gallon ie. 3.15?")
        CostPerTrip = (MilesOneWay * 2 / MilesPerGallon * costOfGasPreGallon)
        MsgBox "Gas Cost is $" & (CostPerTrip)
   End If
End Sub

Skipping rows not needed while in a mainframe using VBA

Level 3
I use this code to skip rows when I am pulling data out of a main frame system.
Dim rowCount As Variant
For rowCount = 11 To 20
    If Int(rowCount / 2) <> rowCount / 2 Then ' this is used to skip rows when you use the divide by 2
        TextVal = curscreen.getstring(rowCount, 3, 7)
        ActiveCell.Offset(0, 0).Value = (TextVal)
        ActiveCell.Offset(1, 0).Select
' Do something here
    End If
Next rowCount

User prompt for opening a workbook

level 5
I use this code below to allow a user to open a workbook. It selects the active tab. If the workbook is not selected the code will display a message box and end.
' Used for opening a workbook and sheet
getNewFilename = Application.GetOpenFilename(Title:="Please select a file")
If getNewFilename = False Then
    MsgBox "Stopping because you did not select a file"
Exit Sub
End If
Workbooks.OpenText filename:=getNewFilename
lookupFilename = ActiveWorkbook.Name
getTabName = ActiveSheet.Name

Excel VBA and internet explorer data minning

level 5
Here is the more complex one I was talking about. It starts off by grabbing the starting address in cell L2. Then it gets the value of the active cell for the ending address. It opens the ie window and places the values in the fields. If the window is already opened it just reuses that window as it loops through the addresses in the spreadsheet until the end of the worksheet and it places the results in the next cell to the right. Now if it comes to an address that is not found or has no miles available. It puts a zero in the field next to the address this lets you know that you need to look these ones up.
Public Sub MapStoresMiles()
'Needs references to Microsoft Internet Controls and Microsoft HTML Object Library.  Set these in Tools - References in the VB Editor.

    Dim ie As InternetExplorer
    Dim URL As String
    Dim HTMLdoc As HTMLDocument
    Dim startAddress As String
    Dim endAddress As String
    Dim iTrip  As String
    Dim iMiles As String
    Dim currentLocation As String
    URL = "https://maps.google.com/maps"
    startAddress = Range("L2").Value
    endAddress = ActiveCell.Offset(0, 0).Value
    If ie Is Nothing Then
        Set ie = CreateObject("InternetExplorer.Application")
        With ie
            .navigate URL
            .Visible = True
            'Wait for initial page to load
            While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
            Set HTMLdoc = .document
        End With
         HTMLdoc.all.d_d.Value = startAddress
    End If
        HTMLdoc.all.d_daddr.Value = endAddress
        'Click the Name Search button
        Application.Wait Now() + TimeValue("00:00:03")
        currentLocation = ie.LocationURL
        iTrip = ""
        iMiles = 0
        On Error Resume Next
          iTrip = HTMLdoc.getElementsByClassName("altroute-info")(0).innerText
          iMiles = Left(iTrip, InStr(iTrip, " ") - 1)
    Workbooks("Mapping Automation.xlsx").Activate
    If iMiles <> "" Then
        ActiveCell.Offset(0, 1).Value = (iMiles)
    End If
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell = ""
MsgBox ("Building milage report is done!")
End Sub

Excel VBA and internet explorer data scraping

level 5
Here I use excel VBA to open up a few pages from excel to internet explorer. I am using a simple example. But they can get much more complicated as I have done a few that are very complex. Here it is just taking the activecell.offset of a cells value and pasting that link into the browser and adding the keyword Excel into a form field. I wanted to use this simple example. In a few weeks I will post a more complex example. Now the key to this is to get the correct form ID to use with the code. Remember you have to have Microsoft Internet Controls and Microsoft HTML Library checked in the Tools and References in order for coding like this to work.
Public Sub Craigslist_Excel_Jobs_Extraction()
'Needs references to Microsoft Internet Controls and Microsoft HTML Object Library.  Set these in Tools - References in the VB Editor.

    Dim ie As InternetExplorer
    Dim URL As String
    Dim HTMLdoc As HTMLDocument
    Dim keywordOne As String
    Dim clickLink As String
    URL = ActiveCell.Offset(0, 0).Value
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .navigate URL
        .Visible = True
        'Wait for initial page to load
        While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
        Set HTMLdoc = .document
    End With
    keywordOne = "Excel"
    clickLink = ActiveCell.Offset(0, 0).Value
    'Populate form fields
    HTMLdoc.all.Query.Value = keywordOne
 ActiveCell.Offset(1, 0).Select
 Loop Until ActiveCell = ""
 End Sub

Using VBA to reset arrays

level 4
I use this to reset my arrays. Some people use the Erase and the ReDim but I find setting it to 0 is much easier to do. Just remember to reset the Array_Counter =1 again in your loop to start it over from 1 again
' I use this to reset my arrays. Remember to add the Array_Counter = 1 again when the code begins its loop through again
array_var = 0
Array_Counter = 0

Function to subtract time form another cell

level 1
I use this function to subtract time
' This will subtract a ending time from a beginning time

Excel keyboard shortcuts

Level 1
Here is some useful keyboard shortcuts
CTRL-C Copies
CTRL-V Pastes that value
CTRL-B Makes the selection bold
CTRL-O opens a spreadsheet
CTRL-T Creates a table from a selection
CTRL-W closes the workbook
CTRL-P brings up the print dialog box
CTRL-S Saves the file
CTRL-A Selects all pieces of the whole worksheet
CTRL-D makes the cells the same from the copy command
CTRL-N Opens a new workbook
CTRL-I Makes the selection Italicize
CTRL U Makses the selection underlined
CTRL-X Undoes the last commands (this does not work with a macro that has been ran)
CTRL-Y Redoes the last command (this does not work with a macro that has been ran)
CTRL-R Copies the cell to the left of the section
CTRL-G Goes to a select row or column Example, type A8 and it will got to A8
CTRL-K Inserts a hyperlink

Excel VBA highlighting rows and columns

level 4
I use this code to highlight entire row and column
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
' this highlights the row and the column that the selected cell is on
' place this code in the actual sheet of the data you want to highlight
Dim colorVal As String
colorVal = RGB(219, 229, 241)
    Cells.Interior.ColorIndex = xlNone
    With ActiveCell
        .EntireRow.Interior.color = (colorVal)
        .EntireColumn.Interior.color = (colorVal)
    End With
End Sub

Finding the last row of data using VBA

Level 3
I use this code to select the last row of a column and place an x in the next cell
Cells(rows.count, "G").End(xlUp).Offset(1, 0).Select 'Gets number of rows and the selects the last row plus one
ActiveCell.Offset(0, 0).Value = ("x") ' place an x in the last row
Range("G2").Select ' Select the starting cell of that column
   ' do some stuff here
ActiveCell.Offset(1, 0).Select ' Select next cell
Loop Until ActiveCell = "x"

Excel VBA comparing two variables

Level 3
I use this code to compare two variables
' used to compare between two values and if it is within those values then do something
ElseIf getValue2 >=490 And getValue2 <=499 Then

using VBA to call other sub routines

level 3
To have the code call other subroutines use this in your code. Tailor it to the application for what you are using it for. It becomes very useful when you need to change the code in a lot of places. Instead this will make it so you only have to change it in one spot instead of several places. So to call this routine in another sub routine you would type this line of code in the routine  Call
callDoThis and this would run the below sub routine.
sub callDoThis()
Dim clearThis As String
clearThis = Range("A17:I27").ClearContents  ' this clears out the main body of information
End Sub

Protection change automated using VBA

level 4
Here I expand one of my earlier post for the Account Services Protection Change. I created a variable to count how many worksheets are in a workbook and used that to do the protection and unprotect the worksheets. that's the nice thing with using excel VBA code and variables. You can normally improve on previous code to use at a later time or to build something else.
Sub AccountServicesProtectionChange()
' created Feb 2013 by Todd Hoerter Specialist Excel
  Dim userInput As String
  Dim x As Variant
  Dim sheetCounter As Integer
  userInput = InputBox("unprotect or protect sheet?")
' find out how many sheets are in a workbook
sheetCounter = ActiveWorkbook.Sheets.count
 If userInput = "unprotect" Then
    For x = 1 To sheetCounter
        ActiveSheet.Unprotect "xxxx"
    Next x
 ElseIf userInput = "protect" Then
    For x = 1 To sheetCounter
        ActiveSheet.Protect "xxxx", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
    Next x
 End If
 Msgbox "This process is done!"
End Sub

Removing worksheet protection on several tabs

level 4
Have you ever wanted to add or remove worksheet protection from a workbook and have several worksheets to do? This workbook has 30 worksheets in it. This will be a different number based upon how many sheets you have in your book. Well here is some code that will make it easy. Of course you will have to know the password in order to remove it. This sub routine also calls up two functions. This is very helpful when you have several repetitive tasks to do. You can also allow a filter to be used on the protected sheet by adding a comma and this (, AllowFiltering:=True) to the AccountServicesProtect function on the line with the password in it.
Sub AccountServicesProtectionChange()
  Dim userInput As String
  Dim x As Variant
  userInput = InputBox("unprotect or protect sheet?")
 If userInput = "unprotect" Then
    For x = 1 To 30
        Call AccountServicesUnprotect
    Next x
 ElseIf userInput = "protect" Then
    For x = 1 To 30
       Call AccountServicesProtect
    Next x
 End If
 MsgBox "This function is done!"
End Sub
Function AccountServicesUnprotect()
    ActiveSheet.Unprotect "yourPasswordHere"
End Function
Function AccountServicesProtect()
    ActiveSheet.Protect "yourPasswordHere", AllowFiltering:=True
End Function

VBA copying information down to another change in data

level 5
Here is something I created to copy information from one cell to another cell all the way down to the point of another change. So when it changes then the code takes that and copys that down to the next change and so on. This code has input boxes so you can select what column has the rows you want to count and what column you wan to copy the information down to.
Sub Copy_Columns_Down_Cells_With_InputBoxes()
' Created November 2011 by Todd Hoerter

    Const FirstRow As Integer = 2
    Dim LastRow As Long
    Dim rowNum As Long
    Dim item As String
    Dim currItem As String
    Dim userInput As Variant
    Dim userInput2 As Variant
    userInput = InputBox("What column has the most data in it to the end of the data structure with no blank rows or cells? Ie..D??")
    userInput2 = InputBox("What column do you want to copy the data down to each section? Ie...A, B, C and so on!!")
    'Get number of rows
    LastRow = Cells(rows.count, "" & userInput & "").End(xlUp).row
    ' Get first item code
    currItem = Cells(FirstRow, "" & userInput2 & "").Value
    For rowNum = FirstRow + 1 To LastRow
    ' Get item code
       item = Cells(rowNum, "" & userInput2 & "").Value
    ' Check if new
    If item <> "" Then
        currItem = item
        Cells(rowNum, "" & userInput2 & "").Value = currItem
    End If
    Next rowNum
End Sub

Counting the rows using VBA to find the last row of data

level 2
When you want to find out how many rows are in a column “A” you can count the rows. This is very helpful especially when you are going to use that to manipulate the data in the sheet.
Sub rowCount()
Dim LastRow As Long
'Count the number of rows of data
LastRow = Cells(rows.count, "A").End(xlUp).row
' Do something cool with the data here
End Sub

 level 1

Removing hyperlinks from a selection of cells using VBA

When removing hyperlinks you can create a sub routine and enter the text as shown below:
Sub delete_hyperlinks()
' created 2010 by Todd H
End Sub