Finding last row used in Excel worksheet

Efficient code available to find the last row used in worksheet would be :

Sub Find_LastRow()
      Dim lngLastRow      As Long
      lngLastRow = Sheets("sheet_name_here").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
      Debug.Print lngLastRow
End Sub

Loop through all excel files and save data in thisworkbook

Sub LoopThroughFiles()
    Dim StrFile         As String
    Dim FolderPath      As String
    Dim Wb              As Workbook
    Dim Ws              As Worksheet
 
    '// give full folder path here (remember \ in the end) .. only excel files should be in the folder
    FolderPath = "C:\Users\vds1\Desktop\UIPath\"
 
    '// Loop through all file names..
    StrFile = Dir(FolderPath)
    Do While Len(StrFile) > 0
        '// open every workbook and assign it to variable wb
        Set Wb = Workbooks.Open(FolderPath & StrFile)
        '// loop through every sheet within open workbook - wb
        For Each Ws In Wb.Sheets
            Ws.Select
            '/copy data and paste in current sheet where macro is saved
            Range("A1:Z" & Range("A" & Rows.Count).End(xlUp).Row).Copy ThisWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        Next Ws
        '// Close workbook without saving and set to nothing (memory clean)
        Wb.Close False
        Set Wb = Nothing
     
        '// move to next file
        StrFile = Dir
    Loop
End Sub



-----------------------------------------------------------------


Sub LoopThroughFiles()
    Dim StrFile         As String
    Dim FolderPath      As String
    Dim Wb              As Workbook
    Dim Ws              As Worksheet

    Application.DisplayAlerts = False
 
    '// give full folder path here (remember \ in the end) .. only excel files should be in the folder
    FolderPath = "C:\Users\vds1\Desktop\Temp\2019\"

    '// Loop through all file names..
    StrFile = Dir(FolderPath)
    Do While Len(StrFile) > 0
        '// open every workbook and assign it to variable wb
        Set Wb = Workbooks.Open(FolderPath & StrFile)
        '// loop through every sheet within open workbook - wb
        For Each Ws In Wb.Sheets
            Ws.Select
            '/copy data and paste in current sheet where macro is saved
            Range("A1:Z" & Range("A" & Rows.Count).End(xlUp).Row).Copy ThisWorkbook.Sheets(Ws.Name).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        Next Ws
        '// Close workbook without saving and set to nothing (memory clean)
        Wb.Close False
        Set Wb = Nothing
   
        '// move to next file
        StrFile = Dir
    Loop
 
    Application.DisplayAlerts = True
End Sub

Delete worksheet if already exist in Excel workbook

To delete the worksheet which already exist you may try the below code.

If there are many sheets to delete , i recommend using separate procedure as shown below and then use the call function whenever needed.

Lets assume we need to delete tab name "Temp" and "Calculations", then you may use the below code.



Sub Main_Macro()
    Call DeleteSheet("Temp")
    Call DeleteSheet("Calculations")
End Sub





Private Sub DeleteSheet(ShtName As String)
Dim Ws As Worksheet
For Each Ws In ActiveWorkbook.Sheets
        If UCase(Ws.Name) = UCase(ShtName) Then
                Ws.Delete
                Exit For
        End If
Next Ws
End Sub

Insertion Sort Using Excel VBA

Many of these sorting algorithm are written in C , C++ and Java.

Same programming  technique is used to develop algorithm using Excel VBA.

How to start ?
1. Copy the below code
2. Open the workbook in which you want to add the code
3. Hold the Alt key, and press the F11 key, to open the Visual Basic Editor
4. Choose Insert | Module
5. Where the cursor is flashing, choose Edit | Paste

How to  run the code?
1. On the Excel Ribbon, click the View tab
2. At the far right, click Macros
3. Select a macro in the list, and click the Run button

 Sub Insertion_Sort()
 Dim Num        As Integer
 Dim C          As Integer
 Dim D          As Integer
 Dim Temp       As Integer
 Dim Arr(1000)  As Integer
 
 Num = InputBox("Enter the number of elements")
 For C = 0 To Num - 1
      Arr(C) = InputBox("Enter the number ")
 Next C
 For C = 1 To Num - 1
        D = C
        Do While D > 0 And (Arr(D) < Arr(D - 1))
            Temp = Arr(D)
            Arr(D) = Arr(D - 1)
            Arr(D - 1) = Temp
            D = D - 1
            If D = 0 Then Exit Do
        Loop
 Next C
 For C = 0 To Num - 1
   Range("A" & C + 1).Value = Arr(C)
 Next C
 End Sub

Delete Entire row if cell is blank or single space using VBA

Lets assume you want to delete Entire row if the cell is blank or having single space in column A, then you can try the below code.


Sub Cells_Blank_OneSpace_EntireRowDelete()
On Error Resume Next
With Range("A2:A1000")
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    .Replace " ", "#N/A", xlWhole
    .SpecialCells(xlConstants, xlErrors).EntireRow.Delete
End With
End Sub

Implementing cell formula to VBA Code

Implementing cell formula to VBA Code

Many people struggle or make mistakes while implementing formula to VBA code. Here is the best way to put the formula to VBA code

Let’s say we have a formula in cell B2 as below

=IF(F2="","",DATEDIF(F2,TODAY(),"d"))

STEP: 1
Open your vb screen  > insert the module and insert below code

Sub insert_formula()
Range (“B2”).Formula=”paste_formula_here”
End sub

STEP: 2
Before you paste your formula within the above quotation you should copy the cell formula to a notepad
after pasting , use CTRL+H key within notepad
Find what: “
Replace with: “”

After replacing  formula will be,

=IF(F2="""","""",DATEDIF(F2,TODAY(),""d""))

Copy the above replaced version and paste it in paste_formula_here  in VBA code

Sub insert_formula()
Range(“B2”).Formula=”=IF(F2="""","""",DATEDIF(F2,TODAY(),""d""))”
End sub

Executing Vlookup function Through VBA

In this section I have shown two ways of executing the vlookup function using VBA Code.

• Evaluate method
• Worksheet function

Suppose I have a table in "sheet1" which involves Product name and its quantity in column A and B as shown in image below, then we can get the quantity details using product name with the help of vlookup.

Remove text or numbers or special Characters in an alphanumeric string using VBA

Remove alphabets and special Characters in an alphanumeric string using VBA

As shown in below image let us assumes we have Range A2 to A6 containing alphanumeric strings and our desired output is shown from B2:B6. VBA code to achieve this results are mentioned below.

Code:

 Sub Remove_Alphabets_SpecialChar_Test()  
   Dim RegX As Object  
   Dim Rng As Range  
   Set RegX = CreateObject("vbscript.regexp")  
   With RegX  
     .Global = True  
     .Pattern = "[^-0-9]"  
   End With  
   For Each Rng In Range("A2:A6")  
     Rng.Offset(, 1) = RegX.Replace(Rng, "")  
   Next Rng  
 End Sub  

Remove alphabets and special Characters from alphanumeric string and retain decimal number using VBA

Well sometimes you may want to keep decimal numbers in desired output. Then you could use the below code.

Code:

 Sub Remove_Alphabets_SpecialChar_RetainDecimalNumber_Test()  
   Dim RegX As Object  
   Dim Rng As Range  
   Set RegX = CreateObject("vbscript.regexp")  
   With RegX  
     .Global = True  
     .Pattern = "[^-0-9-.]"  
   End With  
   For Each Rng In Range("A2:A6")  
     Rng.Offset(, 1) = RegX.Replace(Rng, "")  
   Next Rng  
 End Sub  

Remove numbers and special Characters from alphanumeric string using VBA

To retain alphabets and delete the numbers you can use following code.

Code:

 Sub Remove_Numbers_SpecialChar_Test()  
   Dim RegX As Object  
   Dim Rng As Range  
   Set RegX = CreateObject("vbscript.regexp")  
   With RegX  
     .Global = True  
     .Pattern = "[^-A-Z-a-z]"  
   End With  
   For Each Rng In Range("A2:A6")  
     Rng.Offset(, 1) = RegX.Replace(Rng, "")  
   Next Rng  
 End Sub  

Get Sheet Names without opening the workbook using VBA

Sometimes there could be a scenario where you may want to access the sheet names of a workbook without  opening the file.

This is possible using Activex data objects (ADO)

This code retrieves the sheet names of a workbook without opening the file.

Tested for below format:
.xlsx        .xlsm     .xls 

References :  (Goto VB  IDE >Tools > Refernces )

1. Microsoft ActiveX Data Object X.X Library
2. Microsoft ADO Ext. X.X for DLL and Security

In 2010 Excel this is how references look like

Code:(In New Module)

Option Explicit

Function GetSheetsNames(WBName As String) As Collection

Dim objConn As ADODB.Connection
Dim objCat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim sConnString As String
Dim sSheet As String
Dim Col As New Collection

sConnString = "Provider=Microsoft.ace.OLEDB.12.0;" & _
"Data Source=" & WBName & ";" & _
"Extended Properties=Excel 8.0;"

Set objConn = New ADODB.Connection
objConn.Open sConnString
Set objCat = New ADOX.Catalog
Set objCat.ActiveConnection = objConn

For Each tbl In objCat.Tables
sSheet = tbl.Name
sSheet = Application.Substitute(sSheet, "'", "")
sSheet = Left(sSheet, InStr(1, sSheet, "$", 1) - 1)
On Error Resume Next
Col.Add sSheet, sSheet
On Error GoTo 0
Next tbl
Set GetSheetsNames = Col
objConn.Close
Set objCat = Nothing
Set objConn = Nothing
End Function


Sub Get_File_Names()
Dim Col As Collection, i As Long
Dim FilePathName
Dim wBook As String
FilePathName = Application.GetOpenFilename("xls Files (*.xls*), *.xls*")
If FilePathName <> False Then
  wBook = FilePathName
  Set Col = GetSheetsNames(wBook)
  For i = 1 To Col.Count
    MsgBox Col(i)
  Next i
End If
End Sub

Handling Many controls in a VBA userform

'If you have a form with many text box and other controls almost doing the same job then  you could use the following code (more like control arrays ) to handle the value of many control in one single looping statement.

Code :

'Code - watch immediate window for results.
Dim ObjControl As Control
 For Each ObjControl In Me.Controls
           If TypeOf ObjControl Is MSForms.Label Then  '\\\To loop through just Lables in a Form
                Debug.Print ObjControl.Name
           ElseIf TypeOf ObjControl Is MSForms.TextBox Then '\\\To loop through just textbox in a Form
                Debug.Print ObjControl.Name
           ElseIf TypeOf ObjControl Is MSForms.CommandButton Then '\\\To loop through just buttons in a Form
                Debug.Print ObjControl.Name
                '\\\similarly you can handle multiple controls in form without referring it each time
           End If
 Next

Run saved query with VBA

Let’s say there is a query (Just example) by name “QryPreviousApps_CC_fromdump” in database
While running this example query it would ask you for couple of parameters (Last authenticated date - [prmLastAuthDate] and Cost Number - [prmCstcntr]).

To run the query in VBA, use the following code.

Dim Cn As New ADODB.Connection, Rs As New ADODB.Recordset, Cmd As New ADODB.Command

Public Const dBase1 As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Users\vishal\Desktop\\DB1.mdb;Persist security info=false;Jet OLEDB:Database Password=pswd"

dim dtmLastAuthDate as date, IntCstCntr as integer

 dtmLastAuthDate = #1/1/2012#

IntCstCntr = 1234

Cn.Open dBase1

With Cmd

   .ActiveConnection = dBase1

   .CommandType = adCmdStoredProc

   .CommandText = "QryPreviousApps_CC_fromdump"

   .Parameters.Append .CreateParameter("prmLastAuthDate", adDate, adParamInput, , dtmLastAuthDate)

   .Parameters.Append .CreateParameter("prmCstCntr", adInteger, adParamInput, 9, IntCstCntr)

End With

Rs.Open Cmd, , adOpenKeyset, adLockOptimistic

'Now you can refer the field names using rs!fieldname

Access Database Connection using ADO in VBA

'General Declaration

dB1 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Users\Public\DB1.mdb;Persist security info=false;Jet OLEDB:Database Password=pswd"

'Need Reference to Microsoft Microsoft Activex Data object 2.0 library

Dim Cn As New ADODB.Connection, Rs As New ADODB.Recordset

Dim StrSQL As String

Dim StrName As String

Cn.Open dB1

StrSQL = "select * from LoginDetails" 

Rs.Open StrSQL, Cn, adOpenForwardOnly, adLockReadOnly

Strname = Rs.Fields(0) 'Or Rs!Name

System Idle Time Tracking using VBA

Every time you call the function idle time (either by timer event) in a procedure, it would return the idle time of the computer in seconds.

Here is the code you can try out in Excel module to understand better.  

Before you try out these codes, I recommend you to save & close existing workbook and open a fresh workbook.

Go to Visual Basic editor

Before you proceed make sure immediate window is visible.  To view the window Go to View > Immediate window in VB Editor.

Insert Module (Insert > Module)

Paste the below code

Once pasted highlight your cursor on Idletime_Immediate_Window1 and hit F5

See the immediate window.

For every one second computer idle time is displayed in seconds.

To stop the Macro hold ctrl+break button and execution would stop.

Code:

 '/// Idle Time Tracking  
 Private Declare Sub GetLastInputInfo Lib "user32" (ByRef plii As LASTINPUTINFO)  
 Private Declare Function GetTickCount Lib "kernel32" () As Long  
 Dim SngIdleTime As Single  
 Private Type LASTINPUTINFO  
  cbSize As Long  
  dwTime As Long  
 End Type  
 Function IdleTime() As Single  
  Dim a As LASTINPUTINFO  
  a.cbSize = LenB(a)  
  GetLastInputInfo a  
  IdleTime = (GetTickCount - a.dwTime) / 1000  
 End Function  
 Sub Idletime_Immediate_Window1()  
 Application.OnTime TimeValue(Now) + TimeValue("00:00:01"), "Idletime_Immediate_Window2"  
 Debug.Print IdleTime  
 End Sub  
 Sub Idletime_Immediate_Window2()  
 Application.OnTime TimeValue(Now) + TimeValue("00:00:01"), "Idletime_Immediate_Window1"  
 Debug.Print IdleTime  
 End Sub  

Screenshot :

Get File Names from a folder to excel using VBA

Often times we may need file names from a folder in order to get values from those files using various functions within excel.

How to start ?
1. Copy the below code
2. Open the workbook in which you want to add the code
3. Hold the Alt key, and press the F11 key, to open the Visual Basic Editor
4. Choose Insert | Module
5. Where the cursor is flashing, choose Edit | Paste

How to  run the code?
1. On the Excel Ribbon, click the View tab
2. At the far right, click Macros
3. Select a macro in the list, and click the Run button

Output:
Output will be displayed in active sheet from Cell A2

Code:

Sub GetFileNames()
    Dim xRow As Long
    Dim xDirect$, xFname$, InitialFoldr$
    InitialFoldr$ = "F:\My Documents\"
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder to list Files from"
        .InitialFileName = InitialFoldr$
        .Show
        If .SelectedItems.Count <> 0 Then
            xDirect$ = .SelectedItems(1) & "\"
            xFname$ = Dir(xDirect$, 7)
            Do While xFname$ <> ""
                ActiveCell.Offset(xRow) = xFname$
                xRow = xRow + 1
                xFname$ = Dir
            Loop
        End If
    End With
End Sub

Track current webpage accessed by the user using VBA

Below code provides information on websites that is currently opened in user computer machine.

How to start?

1. Copy the below code
2. Open the workbook in which you want to add the code
3. Hold the Alt key, and press the F11 key, to open the Visual Basic Editor
4. Choose Insert | Module
5. Where the cursor is flashing, choose Edit | Paste

Required Reference :

1. Choose Tools | References 

2. Check Microsoft Internet Controls and click OK (See image below)

To View Immediate Window

Choose View| Immediate Window

How to run the code?

1. On the Excel Ribbon, click the View tab
2. At the far right, click Macros
3. Select a macro in the list, and click the Run button
4. Got VB Screen and See the Immediate window for results

Code:

'\\Requires reference to Microsoft Internet Controls
Dim SWs As SHDocVw.ShellWindows, vIE As SHDocVw.InternetExplorer

'\\Track website used
'\\Establish link to IE application
Sub Track_Website()
Set SWs = New SHDocVw.ShellWindows
For Each vIE In SWs
        '\\Avoid explorer windows/etc this way
        If Left(vIE.LocationURL, 4) = "http" Then
             '\\Watch Immediate window
             Debug.Print vIE.LocationURL
        End If
 Next
End Sub