ASCII code converter : Column Number to Alphabetical reference

The below function be used to convert any Column Number into Alphabets. example :- If you pass 1 to the function, it will Return A. If you pass 26, It will return Z. If you pass 27 It will return AA....and so on.

'ASCII converter
Public Function convert_asc(Target As Integer) As String

Dim high, low As Integer
Dim temp As String
high = Int(Target / 26)
low = Target Mod 26
temp = ""
If high > 0 Then
temp = Chr(high + 64)
End If
temp = temp & Chr(low + 64)
If Target Mod 26 = 0 Then
high = Int(Target / 26)
temp = ""
If high = 1 Then
temp = "Z"
Else
temp = Chr(high + 63) & "Z"
End If
End If
convert_asc = temp
End Function

Delete/ Remove duplicate rows in Excel

Public Sub DeleteDuplicateRows()
'
' This macro deletes duplicate rows in the selection. Duplicates are
' counted in the COLUMN of the active cell.

Dim Col As Integer
Dim r As Long
Dim C As Range
Dim N As Long
Dim V As Variant
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Col = ActiveCell.Column

If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If

N = 0
For r = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(r, 1).Value
If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
Rng.Rows(r).EntireRow.Delete
N = N + 1
End If
Next r

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Query Access from Excel

Sub checkup_backup()
Dim cn As Object, rs As Object, Status As Range
Dim MySql As String, dbfullname As String, myCnt As Long
dbfullname = "c:\Shweta\EFT.mdb"
Set Status = ActiveSheet.Range("A2") 'SQL Variable
MySql = "Select * from Countrymaster"
'Status = Empty 'Clear SQL variable string

Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" _
& dbfullname & ";" 'Create DB connection

Set rs = CreateObject("ADODB.Recordset")
With rs
Set .ActiveConnection = cn
.Source = MySql 'Pass your SQL
.Open , , adOpenStatic, adLockOptimistic
myCnt = .RecordCount
If myCnt > 0 Then
.MoveLast: .MoveFirst
'Pull data to first sheet, cells a1:RecordestCountRow & column 3 _
3 fields in the sql pass
Sheets(1).Range(Cells(1, 1), Cells(myCnt, 2)).CopyFromRecordset rs
End If
.Close
End With
cn.Close
Set rs = Nothing: Set cn = Nothing
End Sub

Change text to Proper case

To change text in a selected range to proper case use this code.

Sub ProperCase()
Dim cell As Range
For Each cell In Selection.Cells
If cell.HasFormula = False Then
cell = strconv(cell.text,vbProperCase)
End If
Next
End Sub

To delete import error tables from database

Sub deleteimporterrors()

Dim tbldef As TableDef
For Each tbldef In CurrentDb.TableDefs
If tbldef.name Like "*_importerror*" Then
DoCmd.DeleteObject acTable, tbldef.name
End If
Next tbldef

End Sub

To Capture Last modified date of the file

If you want to capture last modified date of any file, you can use below code.

Sub test()
Dim fso As Object, myDir As String, fn As String, myFile As String, myDate As Date, maxDate As Date
Set fso = CreateObject("Scripting.FileSystemObject")
myDir = "C:\temp"
fn = Dir(myDir & "\*.csv)
Do While fn <> ""
myDate = fso.GetFile(myDir & "\" & fn).DateLastModified
If maxDate < myDate Then
myFile = fn
maxDate = myDate
End If
fn = Dir()
Loop
MsgBox myDir & "\" & fn & " : " & maxDate
End Sub

Navigation into Worksheets using Listbox

You need to add a ListBox in a UserForm and copy this two simple procedures:

Private Sub UserForm_Initialize()
Dim sht As Worksheet
For Each sht In ActiveWorkbook.Worksheets
ListBox1.AddItem sht.Name
Next sht
End Sub

Private Sub ListBox1_Click()
Sheets(ListBox1.ListIndex + 1).Activate
End Sub

Once you show the UserForm it will add the names of the sheets in the ListBox, then when you click on one of the sheets name in the ListBox it will select the corresponding sheet in the WorkBook. I hope it works