Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adjust data range without opening multiple excel files
Hi,
Codes below copied from the forum are adjusted to suit my need but I have a problem to run the codes each time will open an excel file which will take a few minutes particularly when there are 20 excel files. Is there a better way to run the codes without opening the excel file and save the changes in another folder ? so that I do not have to spend much time to run 20 excel files Sub ChgHeader() Application.Calculation = xlCalculationManual Dim wb As Workbook Dim WBName As String Dim WhatFolder As String WhatFolder = "M:\CA\SP\Bdgt\BAl\dem3\" ChDrive WhatFolder ChDir WhatFolder WBName = Dir("*.xls", vbNormal) Do Until WBName = vbNullString ChDir "M:\CA\SP\Bdgt\BAl\dem3" Application.DisplayAlerts = False Application.ScreenUpdating = False Set wb = Workbooks.Open(WBName) wb.Worksheets("P+L").Select Dim i As Long Dim Lstrow As Long Lstrow = Cells(Rows.Count, "A").End(xlUp).Row If Lstrow 0 Then For i = 5 To Lstrow If Cells(i, 1).Value < "" Then Cells(i, 1).Copy Cells(i, 2).Select ActiveSheet.Paste Application.CutCopyMode = False End If Next Else MsgBox "It appears that the file is empty, check the file again" Exit Sub End If ChDir "M:\CA\SP\Bdgt\BAl\dem4" wb.SaveAs Filename:=Left(WBName, InStrRev(WBName, ".") - 1), FileFormat:=xlNormal wb.Close SaveChanges:=True WBName = Dir() Loop Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.DisplayAlerts = True 'Application.EnableEvents = True End Sub Any helps will be much appreciated as I'm beginner to vba prog Regards Len |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adjust data range without opening multiple excel files
Since all microsfot office products use the same format you can open an
excel file like an Access Database. there are a few minor differences like the spreadsheet names you have to add a dollar sign at the end. so Any method you would use to get database from an Access Database will also work with an Excel workbook. You can query the workbook to read tthe data or use the ADO method. Both types of reads use SQL to extract the data and is quicker than opening the workbooks. I have some example code that you can use to start. This code creates a databae and then writes. It is easy to start by understandig how to create and write the database. Yo ucan search the web and find plenty of examples by google for : Excel VBA ADO read Access Public Const Folder = "C:\Temp\" Public Const FName = "submission.mdb" Sub MakeDataBase() Const DB_Text As Long = 10 Const FldLen As Integer = 40 strDB = Folder & FName If Dir(strDB) < "" Then MsgBox ("Database Exists - Exit Macro : " & strDB) Exit Sub End If ' Create new instance of Microsoft Access. Set appAccess = CreateObject("Access.Application") appAccess.Visible = True ' Open database in Microsoft Access window. appAccess.NewCurrentDatabase strDB ' Get Database object variable. Set dbs = appAccess.CurrentDb ' Create new table. Set tdf = dbs.CreateTableDef("Submissions") ' Create Task/ID field in new table. Set fld = tdf. _ CreateField("Task_ID", DB_Text, FldLen) ' Append Field and TableDef objects. tdf.Fields.Append fld ' Create Client Name field in new table. Set fld = tdf. _ CreateField("Client Name", DB_Text, FldLen) ' Append Field and TableDef objects. tdf.Fields.Append fld ' Create Effective Date field in new table. Set fld = tdf. _ CreateField("Effective Date", DB_Text, FldLen) ' Append Field and TableDef objects. tdf.Fields.Append fld ' Create Imp Mgr field in new table. Set fld = tdf. _ CreateField("Imp Mgr", DB_Text, FldLen) ' Append Field and TableDef objects. tdf.Fields.Append fld ' Create Due Date field in new table. Set fld = tdf. _ CreateField("Due Date", DB_Text, FldLen) ' Append Field and TableDef objects. tdf.Fields.Append fld ' Create Actual Date field in new table. Set fld = tdf. _ CreateField("Actual Date", DB_Text, FldLen) ' Append Field and TableDef objects. tdf.Fields.Append fld ' Create Date Difference field in new table. Set fld = tdf. _ CreateField("Date Difference", DB_Text, FldLen) ' Append Field and TableDef objects. tdf.Fields.Append fld dbs.TableDefs.Append tdf Set appAccess = Nothing End Sub Sub Submit() 'filename of database is with MakeDatabase macro Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset strDB = Folder & FName If Dir(strDB) = "" Then MsgBox ("Database Doesn't Exists, Create Database" & strDB) MsgBox ("Exiting Macro") Exit Sub End If ConnectStr = _ "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & Folder & FName & ";" & _ "Mode=Share Deny None;" cn.Open (ConnectStr) With rs .Open Source:="Submissions", _ ActiveConnection:=cn, _ CursorType:=adOpenDynamic, _ LockType:=adLockOptimistic, _ Options:=adCmdTable If .EOF < True Then .MoveLast End If End With With Sheets("Internal Project Plan") ClientName = .Range("B4") ImpMgr = .Range("B5") LaunchDate = .Range("C4") LastRow = .Range("K" & Rows.Count).End(xlUp).Row For RowCount = 7 To LastRow If UCase(.Range("K" & RowCount)) = "X" Then DueDate = .Range("E" & RowCount) ActualDate = .Range("F" & RowCount) DateDif = .Range("M" & RowCount) Accurate = .Range("L" & RowCount) Task_ID = .Range("B" & RowCount) With rs .AddNew !Task_ID = Task_ID ![Client Name] = ClientName ![Effective Date] = LaunchDate ![Imp Mgr] = ImpMgr ![Due Date] = DueDate ![Actual Date] = ActualDate ![Date Difference] = DateDif .Update End With End If Next RowCount End With Set appAccess = Nothing End Sub -- joel ------------------------------------------------------------------------ joel's Profile: 229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=175500 Microsoft Office Help |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adjust data range without opening multiple excel files
Hi Joel, Thanks for your advice, it will be great to use ADO to access, edit excel file if I have time to do it But due to time constraint to meet the deadline, for time being I need to use back the above codes to run without opening excel files I hope you will help me to modify my codes above just to meet the deadline Thanks & Regards Len |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adjust data range without opening multiple excel files
You can't read a workbook without openning it or using the ADO method. I can fix the code to run much quicker. try these changes. I didn't test the changes so try it in two new folders on one file before running it on a whole directory. change these two lines to test code. SourceFolder = "M:\CA\SP\Bdgt\BAl\dem3\" DestFolder = "M:\CA\SP\Bdgt\BAl\dem4" Changing directories, selecting cells, copying rows one at a time is extremely slow. Sub ChgHeader() Application.Calculation = xlCalculationManual Dim wb As Workbook Dim WBName As String Dim WhatFolder As String Dim i As Long Dim Lstrow As Long Application.DisplayAlerts = False Application.ScreenUpdating = False SourceFolder = "M:\CA\SP\Bdgt\BAl\dem3\" DestFolder = "M:\CA\SP\Bdgt\BAl\dem4\" WBName = Dir(SourceFolder & "*.xls", vbNormal) Do Until WBName = vbNullString Set wb = Workbooks.Open(SourceFolder & WBName) With wb.Worksheets("P+L") Lstrow = .Cells(Rows.Count, "A").End(xlUp).Row If Lstrow = 5 Then Set CopyRange = .Range("A5:A" & Lstrow) CopyRange.Copy _ Destination:=.Range("B5") Else MsgBox ("It appears that the file is empty : " & WBName) Exit Do End If wb.SaveAs Filename:=DestFolder & WBName, FileFormat:=xlNormal wb.Close SaveChanges:=True WBName = Dir() End With Loop Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.DisplayAlerts = True 'Application.EnableEvents = True End Sub -- joel ------------------------------------------------------------------------ joel's Profile: 229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=175500 Microsoft Office Help |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adjust data range without opening multiple excel files
Joel,
Thanks for your quick reply. It seems that it leave me no choice I have to use ADO method............ It still very slow after I use your codes to test on one file and then on whole directory I'll work around on ADO method and see the progress Thanks anyway Regards Len |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adjust data range without opening multiple excel files
Joel,
I think I have a problem to use ADO method for several excel files that had already been completed ( ie budget files already submitted from 25 profit centers (BAI) and 22 cost centers (BAII) respectively under budget directory(dem3) with 2 folders namely BAI and BAII folders) Now the problem is all budget files submitted with incorrect row header format so I need to refill up the row header under column B in one worksheet("P+L") from every budget file and thereafter I will create named range in that "P+L" worksheet of every budget file. Later I will proceed to create a summary budget via data consolidation For data consolidate function, I will use keys selection of row, column headers and create link to data source. I'm in puzzle to which method is the most appropriate to run this batch of excel files for data consolidation purpose, please advise Regards Len |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adjust data range without opening multiple excel files
[I just noticed that you have application.enable events set to true at the end of the program but never turn it off. Try turning it off a see if you get any improvements in speed. -- joel ------------------------------------------------------------------------ joel's Profile: 229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=175500 Microsoft Office Help |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adjust data range without opening multiple excel files
Joel,
Yep....Application.enable events already set to comment line ( ie turn off ) and yet still no improvement Regards Len |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Opening Multiple Excel Files | Setting up and Configuration of Excel | |||
Opening multiple Excel files that contain varied selected sheets | Excel Worksheet Functions | |||
EXCEL Opening Multiple Text Files | Excel Programming | |||
feed data in multiple files without opening them | Excel Programming | |||
opening multiple files using VB and running a mcaro in excel | Excel Programming |