MS Access in VBA

Private Sub CommandButton1_Click()

Dim wbCopy As Worksheet

Set wbCopy = ActiveSheet

' Click on Tools, References and select

' the Microsoft ActiveX Data Objects 2.0 Library

Dim DBFullPath As String

Dim Connect As String, Source As String

Dim Connection As ADODB.Connection

Dim Recordset As ADODB.Recordset

Dim Col As Integer

Dim found As Integer

'Cells.Clear

'Database path info

'DB Path

DBFullPath = "E:\Projects\test.accdb"

'Open the connection

Set Connection = New ADODB.Connection

Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"

Connect = Connect & "Data Source=" & DBFullPath & ";"

Connection.Open ConnectionString:=Connect

'Create RecordSet

Set Recordset = New ADODB.Recordset

Recordset.CursorLocation = adUseClient

With Recordset

'Filter Data

Source = "SELECT * FROM tbl1 WHERE (((tbl1.[fname]) like '%" & wbCopy.Range("A2") & "%')); "

.Open Source:=Source, ActiveConnection:=Connection

'MsgBox "The Query:" & vbNewLine & vbNewLine & Source

'Write field names

For Col = 0 To Recordset.Fields.Count - 1

wbCopy.Range("B1").Offset(0, Col).Value = Recordset.Fields(Col).Name

Next

'Insert rows

found = Recordset.RecordCount

For i = 1 To found - 1

wbCopy.Rows("3:3").Select

Selection.Insert Shift:=xlDown

Next

'Write recordset

wbCopy.Range("B1").Offset(1, 0).CopyFromRecordset Recordset

End With

ActiveSheet.Columns.AutoFit

Set Recordset = Nothing

Connection.Close

Set Connection = Nothing

End Sub

For binding see:
 https://www.devhut.net/2017/02/16/vba-early-binding-and-late-binding-part-2/
https://stackoverflow.com/questions/35647732/excel-vba-late-bind-microsoft-dao-3-6-object-library

For connection strings
https://www.connectionstrings.com/access-2013/ 

Look up data from matrix

Sometimes we need to look up 2 values to get our desired match. Most of times such data  is presented in a matrix form.

Example: We need to get rate for Currency Category pair from the Rate matrix.

Rate matrix
	1	2
INR	1.1	2
AUD	0.25	0.35
USD	0.15	0.5

TransID	Curr	Category	Rate
19000A2	AUD	2
19000A3	AUD	1
19000A4	INR	1

To look up such data, here I will use the offset function and match function.

Offset function format : OFFSET(reference, rows, cols, [height], [width])
Match function format:  MATCH(lookup_value, lookup_array, [match_type])

Formula for the first pair (cell D7):  =OFFSET($A$1,MATCH(B7,$A$2:$A$4,0),MATCH(C7,$B$1:$C$1,0),1,1)

Sensex vs Nifty

Ever wondered why Sensex is around 25,000, whereas Nifty is only around 8,000. 

The table below provides a comparison between the two. See if you can spot the answer.

                

Features	Sensex	Nifty
Base Year	1978-79	1994-1995
Base Value	100	1000
Constituents	30	50
Calculation Method	Free-Float Capitalization (01-Sep-2003)	Free-Float Capitalization (26-June-2009)
Location	Mumbai	Delhi
Authority	Bombay Stock Exchange (BSE)	National Stock Exchange (NSE)
Base Capital	N/A	2.06 Trillion Rs.
Start Date	01-01-1986	03-11-1995

The trick is in the base year, as more time elapsed for Sensex, the index has multiplied more times even though the base is smaller. 

Excel copy from closed file with different column mapping

Private Sub CommandButton1_Click()

Dim wb1 As Workbook
Dim ws1 As Worksheet

Dim wbCopy As Worksheet

Set wbCopy = ActiveSheet

Pathname = ActiveWorkbook.Path & "\Files\"
Filename = Dir(Pathname & "*.xlsm")
Set wb1 = Workbooks.Open(Pathname & Filename)


With wb1.Sheets(1)
 .Range("B4:H4").Select
.Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
End With

wbCopy.Activate
    Range("B4").Select
    ActiveSheet.Paste
    Range("I4").Select
wb1.Activate
With wb1.Sheets(1)
    .Range("K4").Select
    .Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
End With
wbCopy.Activate
    Range("I4").Select
    ActiveSheet.Paste
wb1.Close



End Sub

VBA Excel - Run macro for copying formula in each file of a folder

Private Sub CommandButton1_Click()
Dim Filename, Pathname As String
Dim wb As Workbook

    Pathname = ActiveWorkbook.Path & "\Files\"
    Filename = Dir(Pathname & "*.xlsm")
    Do While Filename <> ""
        Set wb = Workbooks.Open(Pathname & Filename)
        DoWork wb
        wb.Close SaveChanges:=True
        Filename = Dir()
    Loop
End Sub

    Sub DoWork(wb As Workbook)
    With wb
    Dim rng
rng = "P4:P23"
.Sheets(1).Range("P4").Select

Selection.AutoFill Destination:=.Sheets(1).Range(rng)
    .Sheets(1).Range(rng).Select
       
    End With
End Sub

Excel- find file name only from a directory path

=TRIM(RIGHT(SUBSTITUTE(A1,"\",REPT(" ",LEN(A1))),LEN(A1)))

Source: http://stackoverflow.com/questions/18617349/excel-last-character-string-match-in-a-string

VBA - sheet creation and row copy from a consolidated sheet

Module 1 : creation of list of unique values

Range("A1:A10").Select
    Selection.Copy
    Range("G1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$G$1:$G$10").RemoveDuplicates Columns:=1, Header:=xlYes

Module 2: Creation of sheets from list.

Taken from : http://ccm.net/faq/27361-excel-a-macro-to-create-and-name-worksheets-based-on-a-list

Sub CreateSheetsFromAList() 
    Dim MyCell As Range, MyRange As Range 
     
    Set MyRange = Sheets("Summary").Range("A10") 
    Set MyRange = Range(MyRange, MyRange.End(xlDown)) 

    For Each MyCell In MyRange 
        Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet 
        Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet 
    Next MyCell 
End Sub 

Module 3: Copy based on list

Algo: run loop for unique values

Find each row and copy to respective sheet.