Tuesday, December 22, 2009

Like Operator (Usage in VB and VBA)

 Dim testCheck As Boolean


' The following statement returns True (does "F" satisfy "F"?)

testCheck = "F" Like "F"

' The following statement returns False for Option Compare Binary

' and True for Option Compare Text (does "F" satisfy "f"?)

testCheck = "F" Like "f"

' The following statement returns False (does "F" satisfy "FFF"?)

testCheck = "F" Like "FFF"

' The following statement returns True (does "aBBBa" have an "a" at the

' beginning, an "a" at the end, and any number of characters in

' between?)

testCheck = "aBBBa" Like "a*a"

' The following statement returns True (does "F" occur in the set of

' characters from "A" through "Z"?)

testCheck = "F" Like "[A-Z]"

' The following statement returns False (does "F" NOT occur in the

' set of characters from "A" through "Z"?)

testCheck = "F" Like "[!A-Z]"

' The following statement returns True (does "a2a" begin and end with

' an "a" and have any single-digit number in between?)

testCheck = "a2a" Like "a#a"

' The following statement returns True (does "aM5b" begin with an "a",

' followed by any character from the set "L" through "P", followed

' by any single-digit number, and end with any character NOT in

' the character set "c" through "e"?)

testCheck = "aM5b" Like "a[L-P]#[!c-e]"

' The following statement returns True (does "BAT123khg" begin with a

' "B", followed by any single character, followed by a "T", and end

' with zero or more characters of any type?)

testCheck = "BAT123khg" Like "B?T*"

' The following statement returns False (does "CAT123khg"?) begin with

' a "B", followed by any single character, followed by a "T", and

' end with zero or more characters of any type?)

testCheck = "CAT123khg" Like "B?T*"



For complete article follow the below link:

http://msdn.microsoft.com/en-us/library/swf8kaxw(VS.80).aspx

Monday, November 16, 2009

Open website with login and paswd using VBA

The program requires references to the following:

1 Microsoft Internet Controls
2. Microsoft HTML Object Library

The Internet control is used to browse the webpage and the HTML Objects are used to identify the username and password textboxes and submit the text using the control button.

Dim HTMLDoc As HTMLDocument
Dim oBrowser As InternetExplorer
Sub Login_2_Website()

Dim oHTML_Element As IHTMLElement
Dim sURL As String

On Error GoTo Err_Clear
sURL = "https://www.google.com/accounts/Login"
Set oBrowser = New InternetExplorer
oBrowser.Silent = True
oBrowser.timeout = 60
oBrowser.navigate sURL
oBrowser.Visible = True

Do
' Wait till the Browser is loaded
Loop Until oBrowser.readyState = READYSTATE_COMPLETE

Set HTMLDoc = oBrowser.Document

HTMLDoc.all.Email.Value = "sample@vbadud.com"
HTMLDoc.all.passwd.Value = "*****"

For Each oHTML_Element In HTMLDoc.getElementsByTagName("input")
If oHTML_Element.Type = "submit" Then oHTML_Element.Click: Exit For
Next

' oBrowser.Refresh ' Refresh If Needed
Err_Clear:
If Err <> 0 Then
Debug.Assert Err = 0
Err.Clear
Resume Next
End If
End Sub



Sunday, November 15, 2009

Create Barchart using "REPT" function.

Here is the example of REPT function. To create BarChart
 
Units Days Share Function    
100 Sunday |||||  5% =REPT("|",100*A2/$A$9) &"  "& TEXT(A2/$A$9,"0%")
150 Monday |||||||  8% =REPT("|",100*A3/$A$9) &"  "& TEXT(A3/$A$9,"0%")
450 Tuesday ||||||||||||||||||||||  23% =REPT("|",100*A4/$A$9) &"  "& TEXT(A4/$A$9,"0%")
300 Wednesday |||||||||||||||  15% =REPT("|",100*A5/$A$9) &"  "& TEXT(A5/$A$9,"0%")
300 Thursday |||||||||||||||  15% =REPT("|",100*A6/$A$9) &"  "& TEXT(A6/$A$9,"0%")
400 Friday ||||||||||||||||||||  20% =REPT("|",100*A7/$A$9) &"  "& TEXT(A7/$A$9,"0%")
300 Saturday |||||||||||||||  15% =REPT("|",100*A8/$A$9) &"  "& TEXT(A8/$A$9,"0%")
2000 Total    

 

http://www.vbatalent.blogspot.com



Now, send attachments up to 25MB with Yahoo! India Mail. Learn how.

Tuesday, November 10, 2009

Remove workbook password.


'****************************************************************************
' Main procedure
' Open the workbook which you wants to remove password and run the procedure
'****************************************************************************
Sub PasswordBreaker1()
Dim wkb As Excel.Workbook
Set wkb = ActiveWorkbook
Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As Integer, i6 As Integer
On Error Resume Next
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
ActiveWorkbook.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
Application.StatusBar = Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If Not IsProtected(wkb) Then
MsgBox "One usable password is " & Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
Application.StatusBar = False
Exit Sub
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next

End Sub
 
Function IsProtected(objXL As Object) As Boolean
Dim wksht As Excel.Worksheet
Dim cell As Excel.Range
Select Case TypeName(objXL)
 
  Case "Workbook"
    If objXL.ProtectStructure Then
      IsProtected = True
      Exit Function
    Else
        IsProtected = False
      Exit Function
    End If
End Select
End Function


Add whatever you love to the Yahoo! India homepage. Try now!

Wednesday, August 26, 2009

Append data from Multiple workbooks without opening the workbooks

Sub Main
Call AppendData
End Sub
 
 
Function GetFolder(ByVal DefaultPath As String)
On Error Resume Next
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
jmp1:
With fd
.InitialFileName = DefaultPath & "\"
.Show
End With
GetFolder = fd.SelectedItems(1)
If GetFolder = Empty Then GoTo errHandler
Exit Function
errHandler:
MsgBox "Please select a folder."
GoTo jmp1

End Function
 

 
Sub AppendData()
Dim folderpath As String
Dim cnt As DAO.Database
Dim rst As DAO.Recordset
Sheets(1).Select
Range("A2").Select
folderpath = GetFolder("C:")
With Application.FileSearch
.NewSearch
.LookIn = folderpath
.SearchSubFolders = False
.Filename = "*.xls"
.Execute
   
    For i = 1 To .FoundFiles.Count
   
        Set cnt = DBEngine.OpenDatabase(.FoundFiles(i), False, False, "Excel 8.0")
        Set rst = cnt.OpenRecordset("Sheet1$")
        ActiveCell.CopyFromRecordset rst
        Cells(Range("E1").End(xlDown).Row + 1, 1).Select
        rst.Close
        cnt.Close
       
    Next
   
   
End With

End Sub
 
For worksheet example check this url http://groups.google.co.in/group/myvbagroup?hl=en
 


See the Web's breaking stories, chosen by people like you. Check out Yahoo! Buzz.

Thursday, August 20, 2009

Conditional Ranking in Excel

Here is the example of Conditional Ranking
 

 

A

B

C

D

E

1 Date Time IN /Out Ranking as per Dates Done
2 2/1/2009 8:50 IN 1 =SUMPRODUCT(($A$2:$A$13=A2)*(B2>$B$2:$B$13))+1
3 2/1/2009 13:10 OUT 2 =SUMPRODUCT(($A$2:$A$13=A3)*(B3>$B$2:$B$13))+1
4 2/1/2009 14:00 IN 3 =SUMPRODUCT(($A$2:$A$13=A4)*(B4>$B$2:$B$13))+1
5 2/2/2009 8:50 IN 1 =SUMPRODUCT(($A$2:$A$13=A5)*(B5>$B$2:$B$13))+1
6 2/2/2009 13:10 OUT 2 =SUMPRODUCT(($A$2:$A$13=A6)*(B6>$B$2:$B$13))+1
7 2/1/2009 23:00 OUT 4 =SUMPRODUCT(($A$2:$A$13=A7)*(B7>$B$2:$B$13))+1
8 2/2/2009 23:00 OUT 4 =SUMPRODUCT(($A$2:$A$13=A8)*(B8>$B$2:$B$13))+1
9 2/3/2009 8:50 IN 1 =SUMPRODUCT(($A$2:$A$13=A9)*(B9>$B$2:$B$13))+1
10 2/3/2009 13:10 OUT 2 =SUMPRODUCT(($A$2:$A$13=A10)*(B10>$B$2:$B$13))+1
11 2/2/2009 14:00 IN 3 =SUMPRODUCT(($A$2:$A$13=A11)*(B11>$B$2:$B$13))+1
12 2/3/2009 23:00 OUT 3 =SUMPRODUCT(($A$2:$A$13=A12)*(B12>$B$2:$B$13))+1
13 2/1/2009 23:50 IN 5 =SUMPRODUCT(($A$2:$A$13=A13)*(B13>$B$2:$B$13))+1



See the Web's breaking stories, chosen by people like you. Check out Yahoo! Buzz.

Wednesday, August 5, 2009

How to create Dynamic validation list in excel

Example:
 
Let say I have two sheets in a workbook
 
1) Lists
2) Answer
 
Sheet Lists :  has two list as follows
 
Sheet "Lists"
 
Sheet "Answer" is as follows
 
 
1) Create Names as follows ( Insert > Names > Define)
 
Name Sheet Name Formula
Type List =OFFSET(List!$A$2,0,0,COUNTA(List!$A:$A)-1,1)
List1 List =List!$B:$B
List2   =OFFSET(List!$C$1,MATCH(Answer!$A33,List1,0)-1,0,COUNTIF(List1,Answer!$A33),1)
 
 
2) Go to Sheet "Answer" select column A and select Data>Validation from Menu.
3) Select List from Allow drop down.
4) and write  =type in Source textbox press OK.
5) Select the column B and Select Data>Validation from Menu.
6) Select List from Allow drop down.
7) and write  =List2 in Source textbox press OK
 
 

Sunday, August 2, 2009

Send mail without using mail clients (Outlook) through VBA


Sub Sendmail()
Set imsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
 
 
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
    .Item("http://schemas.Microsoft.Com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Range("B4").Value
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mailid
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = pswd
    .Update
End With
 
strBody = " Attached you will  find your MMO notifications from <our company name here> on ship date: " & Format(Date, "mm/dd/yyyy")
 
With imsg
    Set .Configuration = iConf
    .To = mailid
    .CC = ""
    .BCC = ""
    .From = mailid
    .Subject = "Manual Markout Notification - " & Format(Date, "mm/dd/yyyy")
    .TextBody = strBody
    .AddAttachment (ThisWorkbook.Path & "/" & Replace(Replace(shtData.Range("AC2").Value, ".", ""), "/", "") & " " & Format(Date, "mm-dd-yyyy") & ".mhtml")
    .Send
End With
Set Flds = Nothing
Set imsg = Nothing
Exit Sub
Set Flds = Nothing
Set imsg = Nothing
End Sub


Looking for local information? Find it on Yahoo! Local

Saturday, July 25, 2009

Conditional MIN() & MAX()








































We can get the conditional Minimum and Maximum values using as array function.


function used as follows








Press CTRL+Shift+Enter ..... to get result or convert the formula as array function.






Tuesday, July 14, 2009

Check the Autofilter whether it is on or Off

Sub CheckAutofilter()
Dim wks As Worksheet
 
For Each wks In ActiveWorkbook.Worksheets
Range("A2").Select
If Not ActiveSheet.AutoFilterMode = True Then
Selection.AutoFilter
Else
Selection.AutoFilter
End If
Next

End Sub


See the Web's breaking stories, chosen by people like you. Check out Yahoo! Buzz.

Friday, July 10, 2009

Import Excel file using VBA in Access.


'********** Component details ****************
' Add "Microsoft office 10.1 Object Library from Tools > Referance.
' Command2 as Browse Button
' Command3 as Import Button
' Text0 as Textbox
'*********************************************

Private Sub Command2_Click()
' For Get the traget file name along with path
On Error GoTo lb1
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Show
Text0.Value = fd.SelectedItems(1)
Exit Sub
lb1:
MsgBox "No File selected"
Text0.Value = Empty
End Sub


Private Sub Command3_Click()
' To import the targeted file for which path is stored in "Text0" Textbox
aa = InputBox("Please enter the 'Table Name'", "Table Name", "Tbl" & Format(Now, "hhmmss"))
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel, aa, Text0.Value, -1
End Sub


Friday, June 26, 2009

Excel Shortcut Keys

Key

Alone

Shift

Ctrl

Alt

Shift Ctrl

F1

Help

What's This Help

 

Insert Chart Sheet

 

F2

Edit Mode

Edit Comment

 

Save As

 

F3

Paste Name Formula

Paste Function

Define Name

 

Names From Labels

F4

Repeat Action

Find Again

Close Window

Quit Excel

Find Previous

F5

Goto

Find

Restore Window Size

 

 

F6

Next Pane

Prev Pane

Next Window

Previous Window

Prev Workbook

F7

Spell Check

 

Move Window

 

 

F8

Extend Selection

Add To Selection

Resize Window

Macro List

 

F9

Calculate All

Calculate Worksheet

Minimize Workbook

 

 

F10

Activate Menu

Context Menu

Maximize Window

 

 

F11

New Chart

New Worksheet

New Macro Sheet

VB Editor

 

F12

Save As

Save

Open

 

Print

A

 

 

Select All 

 

Formula Arguments

B

 

 

Bold

 

 

C

 

 

Copy

 

 

D

 

 

Fill Down

Data Menu

 

E

 

 

 

Edit Menu

 

F

 

 

Find

File Menu

Font Name

G

 

 

Goto

 

 

H

 

 

Replace

Help Menu

 

I

 

 

Italics

Insert Menu

 

J

 

 

 

 

 

K

 

 

Insert  Hyperlink

 

 

L

 

 

 

 

 

M

 

 

 

 

 

N

 

 

New Workbook

 

 

O

 

 

Open Workbook

Format Menu

Select Comments

P

 

 

Print

 

Font Size

Q

 

 

 

 

 

R

 

 

Fill Right

 

 

S

 

 

Save

 

 

T

 

 

 

Tools Menu

 

U

 

 

Underline

 

 

V

 

 

Paste

 

 

W

 

 

Close Workbook

Window Menu

 

X

 

 

Cut

 

 

Y

 

 

Repeat Active

 

 

Z

 

 

Undo

 

 

` (~)

 

 

Toggle Formula View

 

General Format

1 (!)

 

 

Cell Format

 

Number Format

2 (@)

 

 

Toggle Bold

 

Time Format

3 (#)

 

 

Toggle Italics

 

Date Format

4 ($)

 

 

Toggle Underline

 

Currency Format

5 (%)

 

 

Toggle Strikethru

 

Percent Format

6 (^)

 

 

Toggle Object Display

 

Exponent Format

7 (&)

 

 

Show/Hide Standard Toolbar

 

Apply Border

8 (*)

 

 

Outline

 

Select Region

9 (()

 

 

Hide Rows

 

Unhide Rows

0 ())

 

 

Hide Columns

 

Unhide Columns

-

 

 

Delete Selection

Control Menu

No Border

= (+)

Formula

 

Calculate All

Auto Sum

Insert Cells

[

 

 

Direct Precendents

 

All Precendents

]

 

 

Direct Dependents

 

All Dependents

; (semicolon)

 

 

Insert Date

Select Visible Cells

Insert Time

' (apostrophe)

 

 

Copy Formula From Above

Style

Copy Value Above

: (colon)

 

 

Insert Time

 

 

/

 

 

Select Array

 

Select Array

\

 

 

Select Differences

 

Select Unequal Cells

Insert

Insert Mode

 

Copy

 

 

Delete

Clear

 

Delete To End Of Line

 

 

Home

Begin Row

 

Start Of Worksheet

 

 

End

End Row

 

End Of Worksheet

 

 

Page Up

Page Up

 

Previous Worksheet

Left 1 screen

 

Page Down

Page Down

 

Next Worksheet

Right 1 screen

 

Left Arrow

Move Left

Select Left

Move Left Area

 

 

Right Arrow

Move Right

Select Right

Move Right Area

 

 

Up Arrow

Move Up

Select Up

Move Up Area

 

 

Down Arrow

Move Down

Select Down

Move Down Area

Drop down list

 

Space Bar

Space

Select Row

Select Column

Control Box

Select All

Tab

Move Right

Move Left

Next Window

Next Application

Previous Window

Enter

 

Move Up

Fill Selection With Active Cell

Insert Row

 

BackSpace

 

Collapse Selection To Active Cell

Goto Active Cell

 

 



ICC World Twenty20 England '09 exclusively on YAHOO! CRICKET