Monday, April 13, 2015

Autofit Column using VBA

Sub Hidealternatecolumns()

Dim first As Double
Dim last As Double

first = 4
last = 40

For i = first To last

If Cells(1, i).Column Mod 2 = 0 Then
        Cells(1, i).EntireColumn.Hidden = True
    End If
Next
Range("C8").CurrentRegion.Columns.AutoFit

End Sub


Sunday, April 12, 2015

Send mail with Condition

Dim outlukApp As Outlook.Application, outlukMail, daterng As Range, rowcount As Long, cell


Sub sendMail()
rowcount = ThisWorkbook.Sheets("Data").Range("I" & Rows.Count).End(xlUp).Row

Set daterng = ThisWorkbook.Sheets("Data").Range("I2:I" & rowcount)
For Each cell In daterng
Set outlukApp = New Outlook.Application
Set outlukMail = outlukApp.CreateItem(olMailItem)

        If (cell = Date) Then
         
                With outlukMail
             
                    .Display
                    .To = CStr(cell.Offset(0, 3))
                    .Subject = "Intimation Mail"
                    .HTMLBody = "Dear " & "<b>" & cell.Offset(0, 2) & "</b>,<br>        Please find the attachment of....."
                 
     
                End With
                Application.DisplayAlerts = False
                Application.Wait (Now + TimeValue("00:00:05"))
                'Application.SendKeys "%s"
        End If
        Set outlukApp = Nothing
        Set outlukMail = Nothing
     
Next


End Sub