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.

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.

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 "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

 

 

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

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.

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.

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

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