Search through a two-dimension Matrix with the VLOOKUP-Function

'Place the code below into the standard module
Sub ArrayTest()
Dim arrValue(1 To 100, 1 To 2) As Integer
Dim varTest As Variant
Dim intCounter As Integer, intTest As Integer
intTest = CInt(InputBox("Controldigit enter:", , 5))
For intCounter = 1 To 100
arrValue(intCounter, 1) = intCounter
arrValue(intCounter, 2) = intCounter * 10
Next intCounter
varTest = Application.VLookup(intTest, arrValue, 2, 0)
If IsError(varTest) Then
Beep
MsgBox "Value Not Found!"
Else
MsgBox "Value: " & varTest
End If
End Sub

With a user defined function, determine text, address and sub address of a hyperlink.

'Place the following user defined function in a standard VBA module

Function SplitHype(rng As Range, iInfo As Integer)
Select Case iInfo
Case 0: SplitHype = rng.Value
Case 1: SplitHype = rng.Hyperlinks(1).Address
Case 2: SplitHype = rng.Hyperlinks(1).SubAddress
End Select
End Function

Count only colored cells

'Place the below UDF(user defined function)in a standard VBA module.

Function CountColor(rng As Range, iColor As Integer)
Dim rngAct As Range
Dim iCount As Integer
For Each rngAct In rng.Cells
If rngAct.Interior.ColorIndex = iColor And _
Not IsEmpty(rngAct) Then
iCount = iCount + 1
End If
Next rngAct
CountColor = iCount
End Function

Formula is =countcolor(A1:C6,6)

Ascertain if a File exists in a Directory

'Place the code below into the standard module
Sub File_exists()
Dim dName$
dName = "c:exceltest.xls"
If Dir(dName) <> "" Then
MsgBox dName & " exists!"
Else
MsgBox dName & " does not exist!"
End If
End Sub

VLOOKUP on a Closed Workbook

'Place the code below into the standard module

Sub Reference()

Range("A2").Formula = _

"=VLOOKUP(A1,'c:excel[test1.xls]Sheet1'!A1:B4,2,0)"

End Sub

Construct an Array Formula in VBA

'Place the code below into the standard module

Sub BuildSum()

   Dim z%, i%

   Cells(20, 8).Select

   z = ActiveCell.Row

   For i = 1 To 7

       Cells(z - 1 + i, 6).FormulaArray = _

           "=SUM((r2c1:r23c2=1)*(r2c3:r23c3=" & i & ")*(r2c[-2]:r23c[-2]))"

   Next i

End Sub

Auto Update Sorted List

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A5")) Is Nothing Then
Range("A1:A5").Sort Range("A1"), xlAscending, Header:=xlYes
End If
End Sub

XLOOKUP FUNCTION

Microsoft added this long anticipated function to Excel early part of the 2020. XLOOKUP replaces the old VLOOKUP and offers a whole lot more power and flexibility. I added to Sample Excel Macros section a file to illustrate various different ways of utilizing this valuable function.

How to Compare Two Data Ranges in Excel

On my Projects > Sample Excel Files section I added a file RangeComparison1.xlsx. If curious you may want to open this file and check it for yourself. Change a cell value anywhere in either of the ranges on Sheet1 or Sheet2 then click on the button located on Sheet1. If there is a change i.e. ranges are not identical then VBA will generate another Excel file indicating where the difference is and will highlight in red color, if data is exactly the same then VBA will tell you that as well. There were times that I had to deal with comparing two data sets and tried to use many convoluted and cumbersome formula based methods after I got sick and tired of that process and I have started using this method where applicable.

Extract Year from Text

Extracting a year from text is possible using string functions if the location of the year is fixed in the text within each cell. But in a free form sentence where the year is used anywhere according to the context there is no way of knowing where in the cell the year is located. In this case UDF (user defined function) created in VBA solves the issue and it is stored like another Excel built-in function so typing the name of this function is sufficient in the fomula line.  Refer to the file on macro samples for this example called ExtractYerFromText.xls.  Below is the code used to create the said UDF.
Function GetYear(txt As String) As Integer
   Dim intCounter As Integer
   txt = txt & " "
   For intCounter = 1 To Len(txt) - 4
      If Mid(txt, intCounter, 5) Like "*#### *" Then
         GetYear = Mid(txt, intCounter, 4)
         Exit Function
      End If
   Next intCounter
End Function

Note - - UDF as entered would be   =GetYear(A2)

Assigned to a forms button:

Sub YearCaller()
   Dim x As Integer
   x = GetYear(Range("A2").Value)
   MsgBox x
End Sub

Hide Empty Rows on Print

Use this code block in the standard module to print the range without blank rows in it.
Sub PrintRows()
    Dim TB As Worksheet
    Dim i%, lRow%
    Application.ScreenUpdating = False
    Set TB = Worksheets("Sheet1")
    lRow = TB.[a16384].End(xlUp).Row
    For i = 1 To lRow
        If IsEmpty(TB.Cells(i, 1)) Then TB.Rows(i).EntireRow.Hidden = True
    Next i
    TB.PrintPreview
    TB.Range(TB.Cells(1, 1), TB.Cells(lRow, 1)).EntireRow.Hidden = False
Application.ScreenUpdating = True
End Sub

Create an Access File from within Excel File

Please refer to the file named CreateAccessTable.xls on Projects > Sample Macros section. After downloading this file click on the button and you will see that a new Access file is created and the data on the tab gets appended to the table on that Access file.

Sort by Frequency

You can put the below code in the standard module and assign a button to it on the worksheet. This code sorts the values in a range per the frequency of the values. Regular sort function can't do that so VBA comes handy for this goal. Sub Sort()
   Dim intRow As Integer, intCounter As Integer, intArr As Integer
   Range("A1").Sort key1:=Range("A1"), order1:=xlAscending, header:=xlNo
   Range("B1").Formula = "=countif(A:A,A1)"
   Range("B1:B" & Range("A1").CurrentRegion.Rows.Count).FillDown
   Range("A1").Sort key1:=Range("B1"), order1:=xlDescending, header:=xlNo
   Columns("B").ClearContents
End Sub

Conditional Formatting with VBA

Copy below code in a statndard module of the VB editor. It colors the maximum value in the range in violet.
Sub ConditionalFormat()
   With Selection
      .FormatConditions.Delete
      .FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=" & Range("Field").Cells(1).Address(False, False) & _
         "=MAX(" & Selection.Address & ")"
      .FormatConditions(1).Interior.ColorIndex = 39
   End With
End Sub

User Defined Function (UDF): How can I ascertain if two fields have identical Values?

Place the code below into the standard module of the VB Editor. This is an example of a user defined function. The function name "FieldComparing" can be typed into the formula line for two ranges to be compared. This acts similar to any other Excel built-in formula on the worksheet.  Function FieldComparing(mgOne, rngTwo) As Boolean
Dim rngCell As Range
Dim intCount%
Dim Switch As Boolean
For Each rngCell In mgOne
    intCount = intCount + 1
    If rngCell <> rngTwo.Cells(intCount) Then
      Switch = True
      Exit For
    End If
Next rngCell
If Switch = False Then FieldComparing = True
End Function

List Dates and Week Number

Assign this code to a forms button:

Sub DatesAndWeeks()
   Dim iCount As Integer, iCounter As Integer
   If Month(DateSerial(Year(Date), 2, 29)) = 2 Then
      iCount = 366
   Else
      iCount = 365
   End If
   For iCounter = 1 To iCount
      Cells(iCounter, 1) = DateSerial(Year(Date), 1, iCounter)
      Cells(iCounter, 2) = WeekNumberID(Cells(iCounter, 1))
   Next iCounter
End Sub

Enter in a module as support for the above macro:

Private Function WeekNumberID(dat As Date) As Integer
   Dim dbl As Double
   dbl = DateSerial(Year(dat + (8 - Weekday(dat)) Mod 7 - 3), 1, 1)
   WeekNumberID = (dat - dbl - 3 + (Weekday(dbl) + 1) Mod 7) 7 + 1
End Function

How can I make Excel ask for a Start- and Enddate via an InputBox and then mark both dates colored?

'Place the code below into the standard module
Sub ToMark()
Dim gCell As Range
Dim Start
Dim EndDate
    On Error GoTo ErrorHandler
    Start = CDate(InputBox("Start:"))
    Set gCell = Columns(1).Find(DateValue(Start), LookIn:=xlFormulas)
    If gCell Is Nothing Then GoTo ErrorHandler
    gCell.Interior.ColorIndex = 3
    EndDate = CDate(InputBox("End:"))
    Set gCell = Columns(1).Find(DateValue(EndDate), LookIn:=xlFormulas)
    If gCell Is Nothing Then GoTo ErrorHandler
    gCell.Interior.ColorIndex = 3
    End
ErrorHandler:
    Beep
    MsgBox "Not Valid Date!"
End Sub

Array Function

See the sample file posted on Various Macro Samples section under Projects menu as of 12/14/2017. This file does not have any VBA code or a macro but shows the array function example in the worksheet formula box. Note the explanation box on the worksheet.

INDIRECT FUNCTION

For this example please refer to the file named as as INDEX_MATCH SAMPLE.xlsm on the Excel Samples part of the Projects section of this site. On this file tab named Match has INDEX_MATCH function along with the INDIRECT function. The yellow cell uses the data validation list seeing the range E10:E14 as a reference. Notice that the formulas in the column F use the INDIRECT function along with the INDEX_MATCH to show the matching values per the selection in the yellow cell in the G column. Formula reads as=INDEX(INDIRECT($E$2),MATCH(R3,IF($P$2:$P$250=Q3,$K$2:$K$250),0))

INDEX and MATCH Function

INDEX and MATCH function offers a power where VLOOKUP fails. For example you can use VLOOKUP to get the corresponding value for a lookup value in a different range on a different tab even on a different file. Yet the same lookup value might have different values associated with it, say it is a category per criteria and several values roll into it on the next column. In this case VLOOKUP will sta on the first occurance of that lookup value and if you copy this down you will get the valuw for that occurance only. But using INDEX-MATCH function resolves this issue. below is provided a sample function that can be used on the Excel's formula line. You can tweak it for your data and give it a try. On my Excel macro samples you can actually find a working copy of this code. =IF(ISERROR(INDEX($A$1:$B$22,SMALL(IF($A$1:$A$22=$O$1,ROW($A$1:$A$22)),ROW(6:6)),2)),"",INDEX($A$1:$B$22,SMALL(IF($A$1:$A$22=$O$1,ROW($A$1:$A$22)),ROW(6:6)),2))

SAP Analysis Office on Excel

Analysis Office (AO) for Excel looks like running into some issues with the 64-bit Office installation. This is more appearent with the AO ver. 2.4 but ver. 2.5 might have a better performance. This issue might be resolved by installing some additional patches for the AO. Below link offers some good insight on this issue. https://wiki.scn.sap.com/wiki/display/BI/Analysis+Office+Installation+and+Update

Dynamically Refreshing Pivot Tables

Below VBA code refreshes dynamically changing range for multiple pivot tables. If let's say there are several pivot tables on the file and after each update their range is subject to change. In this case one has to manually readjust the range for each pivot table and imagine if there are 20 or more of them and this needs to be done weekly or monthly, so it takes a painful amount of time. By incorporating the code displayed below one can update all the pivots on the file with a single click of a button. Just change the worksheet names of your file and pivot table names displayed on the top left corner of the pivot page when you are on the pivot area accordingly after palcing the code in a VBA module. Sub UpdatePivotTableRange()Dim Data_Sheet As Worksheet
Dim Pivot_Sheet As Worksheet
Dim StartPoint As Range
Dim DataRange As Range
Dim PivotName As String
Dim NewRange As String
Dim LastCol As Long
Dim lastRow As Long'Set Pivot Table & Source Worksheet
Set Data_Sheet = ThisWorkbook.Worksheets("Data")
Set Pivot_Sheet = ThisWorkbook.Worksheets("Pivot")'Enter in Pivot Table Name
PivotName = "PivotTable1"'Defining Staring Point & Dynamic Range
Data_Sheet.Activate
Set StartPoint = Data_Sheet.Range("A1")
LastCol = StartPoint.End(xlToRight).Column
DownCell = StartPoint.End(xlDown).Row
Set DataRange = Data_Sheet.Range(StartPoint, Cells(DownCell, LastCol))NewRange = Data_Sheet.Name & "!" & DataRange.Address(ReferenceStyle:=xlR1C1)'Change Pivot Table Data Source Range Address
Pivot_Sheet.PivotTables(PivotName). _
ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange)

'Ensure Pivot Table is Refreshed
Pivot_Sheet.PivotTables(PivotName).RefreshTable'Complete Message
Pivot_Sheet.Activate
MsgBox "Your Pivot Table is now updated."
End Sub