VBA Macro to Insert Rows based on Cell Value in Excel

Excel VBA Macro to Insert Rows based on Cell Value
Sub InsRows()

Dim X As Integer
Dim Y As Integer
Dim Z As Integer
K = 0

For X = 2 To 100

Y = Cells(X, 1).Value
    
    For Z = 1 To Y
          Cells(X, 1).Offset(1, 0).Rows.Insert
          Cells(X, 1).Offset(1, 0).Interior.ColorIndex = 24    
          K = K + 1
    Next Z

    X = (X + K)
    K = 0
 Next X

End Sub
------------------------------------------------------------------------------------------------
Example:
Suppose we have specified how many rows need to insert a as specified as follows:

Output:
Now the above Macro will insert the rows after each cell as shown below, based on number specified.

How to Find when the Table got refreshed last in SQL Server

How to Find when the Table last updated by user in SQL Server

SELECT OBJECT_NAME(OBJECT_ID) AS DatabaseName, last_user_update,*

FROM sys.dm_db_index_usage_stats

WHERE database_id = DB_ID( 'TAMATAM')     --Database name need to pass here

AND OBJECT_ID=OBJECT_ID('TBL_Weekly_Data') –Table name need to pass here

Thanks,

TAMATAM

VBA Macro to Consolidate Specific Columns from Multiple Sheets into One Column of Target Sheet and Remove Duplicates

How to Consolidate Specific Columns from Multiple Sheets into One Sheet in One Column and Remove Duplicates with Excel VBA
The following Macro Consolidates the Specific Fields(Sales Regions) from two Sheets "Data" and "Data_Cloud" into the Sheet "Hierarchy" in One Column(say B2), the assigning then Tags(SR1,SR2...) in Column A, then Removes the Duplicates.
Sub Consol_Hierarchy()

Dim WS As Worksheet
Dim TGT_WS As Worksheet
Dim LV As String

Set TGT_WS = Sheets("Hierarchy")
RC = TGT_WS.Cells(Rows.Count, "A").End(xlUp).Row
TGT_WS.Range("A2", Cells(2, 1).Offset(RC - 1, 1)).Clear

For Y = 1 To 2

If Y = 1 Then
    Set WS = Sheets("Data")
 Else
    Set WS = Sheets("Data_Cloud")
End If

'CC = WS.Cells(1, Columns.Count).End(xlToLeft).Column
'RC = WS.Cells(Rows.Count, "A").End(xlUp).Row

For K = 1 To 6

    Select Case K
    Case 1
            SR = "Sales Region1"
            LV = "SR_1"
    Case 2
            SR = "Sales Region 2"
            LV = "SR_2"
    Case 3
            SR = "Sales Region 3"
            LV = "SR_3"
    Case 4
            SR = "Sales Region 4"
            LV = "SR_4"
    Case 5
            SR = "Sales Region 5"
            LV = "SR_5"
    Case Else
            SR = "Sales Region 6"
            LV = "SR_6"
    End Select

WS.Activate
For X = 1 To 20
    If WS.Cells(1, X) = SR Then
    
        WS.Cells(1, X).Select
        RC = WS.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
        'Range(Selection, Selection.Offset(RC - 1, 0)).Select
        Range(Selection, Selection.Offset(RC - 1, 0)).Copy
        TGT_WS.Activate
        RC1 = (TGT_WS.Cells(Rows.Count, "A").End(xlUp).Row) + 1
            TGT_WS.Range("B" & RC1).Select
            TGT_WS.Paste
            TGT_WS.Range("A" & RC1).Select
            TGT_WS.Range(Selection, Selection.Offset(RC - 1, 0)).Select
            Selection.Value = LV
        
            TGT_WS.Columns("A:B").Select
            Selection.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
            TGT_WS.Range("A1").Select
            Exit For
    End If

Next X

Next K
Next Y

Set WS = Nothing
Set TGT_WS = Nothing
 MsgBox "All the SR Nodes Consolidated from Data and Data_Cloud Tabs", vbOKOnly, "Nodes Consolidated Succesfully"

End Sub

Thanks,TAMATAM

VBA Macro to Find All exact Matches of a String in a Specific Sheet in Excel

Excel VBA Macro to Search or FindAll exact Matches of String  in a Specific Sheet and get the Address of Cell,Column and Row details of each Match
Note: Please note that the Macro will Search/Find in the Used Range of the source data.
Sub FindStrAll()
Dim Srch_Result As Range
Dim LastCell As Range
Dim MyRng As Range
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim Srch_Str As String

Set Sht = ThisWorkbook.Sheets("Results")
Set Src_Sht = ThisWorkbook.Sheets("Data")
    
    Src_Sht.Activate
    Src_Sht.Cells.Select
    
Set LastCell = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)
Set MyRng = Src_Sht.Range("$A$1:" & LastCell.Address)

 X = 2
 Y = 2
 Z = 0

 Do Until Sht.Range("A" & Y).Value = ""
    Srch_Str = Sht.Range("A" & Y).Value
    Str_Cnt = Application.WorksheetFunction.CountIf(MyRng, Srch_Str)

'Set Srch_Result = Selection.Find(What:=Srch_Str, After:=LastCell)
 Set Srch_Result = Selection.Find(What:=Srch_Str, After:=LastCell, _
                    LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

    If Srch_Result Is Nothing Then
        MsgBox "Search Item Not Found in Source Data", vbOKOnly, "Search Completed"
    Else

        Do While Not Srch_Result Is Nothing
           Srch_Result.Activate 'Activating the search result in source data sheet
           Z = Z + 1
               Sht.Range("A" & X).Offset(0, 1).Value = ActiveCell.Value
               Sht.Range("A" & X).Offset(0, 2).Value = ActiveCell.Address
               Sht.Range("A" & X).Offset(0, 3).Value = Cells(1, ActiveCell.Column).Value
               Sht.Range("A" & X).Offset(0, 4).Value = ActiveCell.Column
               Sht.Range("A" & X).Offset(0, 5).Value = ActiveCell.Row
           Set Srch_Result = Selection.FindNext(After:=ActiveCell)
           
           X = X + 1
           If Z = Str_Cnt Then Exit Do
        Loop

        Z = 0    
    End If

    Y = Y + 1   'Increment of Search Strings range variable
  Loop

Sht.Activate
Sht.Range("A1").Select

Set Srch_Result = Nothing
Set Sht = Nothing
Set Src_Sht = Nothing
Set LastCell = Nothing
Set MyRng = Nothing

End Sub
-----------------------------------------------------------------------------------------------------------------------
Example: 
Suppose the we have the Source data as follows where we want to search/find a string as follows:

The Output of the Macro is as follows:

Thanks,TAMATAM

VBA Macro to Find or Search a String in a Specific Sheet in Excel

Excel VBA Macro to Find or Search a String  in a Specific Sheet and get the Address of Cell,Column and Row details
Please note that Search string should be unique in the source data and the below macro returns the first find result details only, though multiple occurrences find in source.
Sub FindStr()
Dim Srch_Result As Range
Dim LastCell as range
Set Sht = ThisWorkbook.Sheets("CPanel")
Set Src_Sht = ThisWorkbook.Sheets("Data")

Srch_Str = Sht.Range("A2").Value
    
    Src_Sht.Select
    Cells.Select

 Set LastCell = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)   
' Set Srch_Result = Selection.Find(What:=Srch_Str, After:=LastCell)

' To Search directly in the specific Column
' Srch_Result = Sheets("MySht").Columns(2).Find(What:=Srch_Str, LookAt:=xlWhole)

 Set Srch_Result =Selection.Find(What:=Srch_Str, After:=ActiveCell, LookIn:= _
      xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
     xlNext, MatchCase:=False, SearchFormat:=False)
' Selection.FindNext(After:=ActiveCell).Activate

   If Not Srch_Result Is Nothing Then
   
        Srch_Result.Activate
        Sht.Range("A2").Offset(0, 1).Value = ActiveCell.Address
        Sht.Range("A2").Offset(0, 2).Value = Cells(1, ActiveCell.Column).Value
        Sht.Range("A2").Offset(0, 3).Value = ActiveCell.Column
        Sht.Range("A2").Offset(0, 4).Value = ActiveCell.Row
    
    Else
    
    MsgBox "Search Item Not Found", vbOKOnly, "Search Completed"
    ActiveSheet.Range("A1").Select
    
   End If
               Set Srch_Str = Nothing
               Set Sht = Nothing
               Set LastCell=Nothing
               Set Src_Sht = Nothing
 End Sub

Source Data , where we search a string : 

Macro output:

Thanks,
TAMATAM

How to Get the Cell Address of a Matching Column and Row in Excel

Excel Function to Get the Address of Matching Column and Row in Excel
Suppose we have the Field or Column names as follows in the source data tab as follows :

Now in our calculation sheet, if you want to capture the Address/Column Index Number/Name details of the lookup Fields/Column Names, we can do as follows :

Lets say the source data tab is "Data", and our lookup Fileds/Columns names in Column A which exists in Row 1 in source data tab, then now the formulas to get each item from source is as follows:
Field Address in Source:
 =(ADDRESS(1,MATCH(A2,Data!$A$1:$AH$1,0),1))

Field Row Number:
 =MID(B2,FIND("$",B2,2)+1,LEN(B2)-FIND("$",B2,2))

Field Column Number:
 =MATCH(A2,Data!$A$1:$AH$1,0)

Field Column Index Name:
 =LEFT(B2,FIND("$",B2,2)-1)

Thanks,
TAMATAM

VBA Switch Statement Syntax and Example

SWITCH statement in VBA:
The SWITCH statement in VBA evaluates a list of conditions and returns the value of the True/match condition from list.
Incase of False it will returns the NULL value, that we need to handle by If condition to perform the False case operation.
Syntax:
Switch ( Condition1,value1, Condition2,value2, ... ConditionN,valueN)
Here:
Condition1,Condition2...ConditionN are the conditions to be evaluate.
value1, value2, ... valueN are the values to be written if the corresponding condition is true.

Example:
In the below example we are checking the Range("A1") value and returing the Grade type in Range("B1") 

Sub SwitchStatement()
Dim XValue As String
Dim X As Integer
X = ActiveSheet.Range("A1").Value

 XVal = Switch((X > 75 Or X = 100), "A-Grade", (X >= 50 And X < 75), "B-Grade", (X < 50 And X >=35), "C-Grade")

If IsNull(XVal) = True Then
    ActiveSheet.Range("B1").Value = "Not Applicable"
Else
    ActiveSheet.Range("B1").Value = XVal
End If
End Sub

Thanks,

TAMATAM

Select Case Statement Syntax with Examples in VBA

VBA Select Case Statement Syntax with Examples :
The Select-Case statement Checks a Variable or an Expression for different Cases (values). If anyone of the Case becomes true then only that Case block is executed and the Program ignores all other Cases.

Syntax:
Select Case Condition/Variable
Case Val_1
Code to Execute When Condition = Val_1
Case Val_2
Code to Execute When Condition = Val_2
Case Val_3
Code to Execute When Condition = Val_3
Case Else
Code to Execute When all the other cases are False
End Select

Here:
 ‘Condition’ refers to the Variable or the Expression that is to be Tested and based on which anyone of the Case blocks will be executed.

'Val_1', 'Val_2' and 'Val_3' are the possible outcomes/values of the ‘Condition’. Whenever anyone of these values matches the ‘Condition’ then its corresponding Case block will execute.

'Else' is a kind of default Case value, which will only execute when all the above Case statements result into False. Else case is optional.

Example 1: Select Case Statement to Check a simple True or False Condition:
In the below example, we have supplied a condition (i.e. J=K) to the Select Case statement. If this is True then ‘Case True’ block will be executed and if it is False then ‘Case False’ block will execute.

Sub Case_Example1()  
'Enter the value for Input variables  
J= InputBox("Enter the value for J:")  
K = InputBox("Enter the value for K:")  
' Evaluating the expression  
Select Case J = K  
Case True  
  MsgBox "The expression is TRUE"  
Case False  
  MsgBox "The expressions is FALSE"  
End Select  
End Sub  

Example 2: Case statement to check Text Strings data:
In this example we will compare text strings in the Case statements. If a match is found then the corresponding Case block will execute otherwise the ‘Case Else’ block will execute.

Sub Case_Example2()  
'Enter the value for variable  Color_name
Color_name = InputBox("Enter the your favorite Color Name:")  
' Evaluating the expression  
Select Case Color_name
Case "Green"  
  MsgBox "You entered Color name as Green"  
Case "Blue"  
  MsgBox "You entered Color name as Blue"  
Case "Yellow"  
  MsgBox "You entered Color name as Yellow"    
Case Else  
  MsgBox "You entered Color name is not the in the Case"    
End Select  
End Sub  

Example 3: Case statement to Check Numbers:
In the below example we will check if the number entered by user is less than or greater than 10.

Sub Case_Example3()  
'Enter the value for  Input variable Num
Num = InputBox("Enter any Number between 1 to 20:")  
' Evaluating the expression  
Select Case Num  
Case Is < 10  
  MsgBox "The Number you entered is less than 10"  
Case Is = 10  
  MsgBox "The Number you entered is Equal to 10"  
Case Is > 10  
  MsgBox "The Number you entered is greater than 10"  
End Select  
End Sub  

Note: You can use IS keyword with Case Statement to compare values.


Example 4: Select Case statement to check multiple conditions inside a single case:
In this example we will enter any number from 1-10. and then we will check if the number is even or odd by using multiple conditions in the Case statement. Notice here I have used a “,” (comma) to check and compare multiple conditions in a single Case statement.

Sub Select_Case_Example4()  
'Enter the value for Input variable Num 
Num = InputBox("Enter any Number between 1 to 10:")  
'Evaluating the expression  
Select Case Num  
Case 2, 4, 6, 8, 10  
  MsgBox "Your Number is Even."  
Case 1, 3, 5, 7, 9  
  MsgBox "Your Number is Odd."  
Case Else  
  MsgBox "Your Number is out of the range."  
End Select  
End Sub  

Example 5: Case statement to check a continuous range as condition:
Here we will test a continuous range as a condition. We will enter any number between 1-10, if the number is between 1 to 5 (including both 1 and 5) then ‘Case 1 To 5’ will be ‘True’, if the number entered by the user is between 6 and 10 (including both 6 and 10) then ‘Case 6 To 10’ will be ‘True’, if both the previous cases are ‘False’ then ‘Case Else’ will be executed.

Sub Case_Example5()  
'Enter the value for Input variable Num 
Num = InputBox("Enter any Number between 1 to 10:")  
'Evaluating the expression  
Select Case Num  
Case 1 To 5  
  MsgBox "Your Number between 1 to 5"  
Case 6 To 10  
  MsgBox "Your Number between 6 to 10"  
Case Else  
  MsgBox "Your Number is out of the range."  
End Select 
End Sub  

Example 6 : Case Statement to to Check If a Variable or Range value exist in Multiple data ranges :
We can check if a Range A1 exist between 100 and 500 also between 501 and 1000 also between1001 and 1500 then execute the true Case statement as follows:

Sub Select_Case_Example6()
 X=Range("A1").Value
    Select Case X
        Case 100 To 500, 501 To 1000, 1001 To 1500
             Range("B1").Value =X
       Case Else
             Range("B1").Value = 0
     End Select
End Sub

Example 7 : Case Statement to to Check If a Variable or Range value exist in Multiple data ranges and mix of additional Numbers and Text values:
We can check if a Range A1 vale is [100 to 500] , 555 and [600 to 900],999 and [1001 to1500],2000 and "Product","Service" then execute the true Case statement as follows:

Sub Select_Case_Example7()
 X=Range("A1").Value
    Select Case X
           Case 100 To 500, 555,600 To 900, 999,1001 To 1500,2000,"Product", "Service"
                 Range("B1").Value = Range("A1").Value
           Case Else
                 Range("B1").Value = 0
     End Select
End Sub


Thanks,
TAMATAM

How to Store the Formula result into a Variable in Excel VBA

Excel Formula to get the Workbook Path and store into a Variable in VBA
Sub Formula_Variable()
Dim SrcSht As Worksheet

Application.DisplayAlerts = False

    Set SrcSht = ThisWorkbook.Sheets("Src_Sht")

    F1 = Evaluate("=LEFT(CELL(""FileName""),FIND(""["",CELL(""FileName""),1)-1)")
    
    SrcSht.Range("C3").Value = F1

End Sub

Notes :

Here the Formula "=LEFT(CELL(""FileName""),FIND(""["",CELL(""FileName""),1)-1)" will returns the Active workbook path.

The Evaluate() Function returns the formula result.

VBA Macro to Import the Data from Text file to Excel

VBA Macro to Import the Data from Text(.txt) file to Excel(.xls) and Save in Destination Folders
Sub Import_Txt_Data()

Dim Tgt_WB As Workbook
Dim SrcSht As Worksheet
Dim TgtSht As Worksheet

Application.DisplayAlerts = False

Set SrcSht = ThisWorkbook.Sheets("CPanel")

 Set Tgt_WB = Workbooks.Add(1)
 Set TgtSht = Tgt_WB.Sheets(1)

 TgtSht.Activate
 TgtSht.Range("A1").Select

 'ConStr = "TEXT;C:\Users\Tamatam\Desktop\Ad_hoc\Txt_Data.txt"
 ConStr = "TEXT;" & SrcSht.Range("C3").Value

    With TgtSht.QueryTables.Add(Connection:=ConStr _
        , Destination:=Range("$A$1"))
        .Name = "Data_Import"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .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, 1) 
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    TgtSht.Range("A1").Select
   'Saving the Imported data as Excel[97-2003] format in Target Foders.
        For S = 3 To 6
            SavePath = SrcSht.Range("D" & S).Value & "\"
            Tgt_WB.SaveAs SavePath & "Txt_Data", 56
        Next S
            Tgt_WB.Close , True
            
 MsgBox "Data Imported from Source .txt File to XL[97-2003] and Saved in Destination  Folders", vbOKOnly, "Import Success"

    Application.DisplayAlerts = True
    Set SrcSht = Nothing

    Set Tgt_WB = Nothing
    Set TgtSht = Nothing
End Sub
---------------------------------------------------------------------------------------------------------------
Notes:
The main file formats in Excel 2007-2016:

51 = xlOpenXMLWorkbook (without Macros in 2007-2013, xlsx)
52 = xlOpenXMLWorkbookMacroEnabled (with or without Macros in 2007-2013, xlsm)
50 = xlExcel12 (Excel Binary Workbook in 2007-2013 with or without Macros, xlsb)
56 = xlExcel8 (97-2003 format in Excel 2007-2013, xls)

We can use the File Format Numbers instead of the defined File Format Constants in the code so that it will compile OK when we copy the code into an Excel 97-2003 workbook. 

For example, Excel 97-2003 won't know what the File Format constant xlOpenXMLWorkbookMacroEnabled , but it understands File Format number 52.

In Excel for the Mac the Format Number values are +1 as follows :
xlsx = 52
xlsm = 53
xlsb = 51
xls = 57

VBA Macro to List the Information of all the Pivots of a Workbook into to a New Sheet

How to Get the Information of all the Pivots of a Workbook into to a New Sheet
Sub ListPivotsInfo()
    Dim St As Worksheet
    Dim NewSt As Worksheet
    Dim Pvt As PivotTable
    Dim I, K As Long
    Application.ScreenUpdating = False
    Set NewSt = Worksheets.Add
    NewSt.Name = "Pivot Info"
    I = 1: K = 2
    With NewSt
        .Cells(I, 1) = "Pivot Name"
        .Cells(I, 2) = "Data Source"
        .Cells(I, 3) = "Refreshed By"
        .Cells(I, 4) = "Refreshed On"
        .Cells(I, 5) = "Pivot Sheet"
        .Cells(I, 6) = "Pivot Location"
        For Each St In ActiveWorkbook.Worksheets
            For Each Pvt In St.PivotTables
                I = I + 1
                .Cells(I, 1).Value = Pvt.Name
                .Cells(I, 2).Value = Pvt.SourceData
                .Cells(I, 3).Value = Pvt.RefreshName
                .Cells(I, 4).Value = Pvt.RefreshDate
                .Cells(I, 5).Value = St.Name
                .Cells(I, 6).Value = Pvt.TableRange1.Address
            Next
        Next
        .Activate
    End With
    Application.ScreenUpdating = True
End Sub

Thanks,
TAMATAM

VBA Macro to Convert Dates to MDY Format

Text to Columns Method for Dates Conversion to MDY Format
Sub Convert_Dates()

    CL = Selection.Column
    CLN = Split(Cells(, CL).Address, "$")(1)
    
    Selection.TextToColumns Destination:=Range(CLN & 1), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 2), TrailingMinusNumbers:=True

    Selection.TextToColumns Destination:=Range(CLN & 1), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 4), TrailingMinusNumbers:=True

    Selection.TextToColumns Destination:=Range(CLN & 1), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 3), TrailingMinusNumbers:=True

End Sub

How to Export Excel Range as a Picture to Target Folder

VBA Macro to Export Excel Named Range as a Picture to Target Folder
The following Macro will export the each Named Range like "MyRng*" as a image to the specified target folder.
Sub Export_Ranges_As_Images()
 Dim Nam_Rng As Range
 Dim RngExp As Range
Dim  Nam as Name

 K = 123456

 For Each Nam In Names

    If Nam.Name Like "MyRng*" Then
       K = K + 1
       
       Set RngExp = ThisWorkbook.Names(Nam.Name).RefersToRange
       Set RngSht = ThisWorkbook.Sheets(RngExp.Parent.Name)
       
       RngExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
       
       Set Tgt_Cht = RngSht.ChartObjects.Add(Left:=RngExp.Left, Top:=RngExp.Top, _
                       Width:=RngExp.Width, Height:=RngExp.Height)

           With Tgt_Cht
               .Name = "TempArea"
               .Activate
           End With
    
       RngSht.ChartObjects("TempArea").Chart.Paste
       RngSht.ChartObjects("TempArea").Chart.Export "C:\Users\Tamatam\Desktop\Temp\" & "Image_" & K & ".jpg"
       RngSht.ChartObjects("TempArea").Delete
    End If

 Next

 End Sub
------------------------------------------------------------------------------------------------------------------------------
Output :