Modify This Code for WorkBook Loop

As you can see the code below, everything is the same, except
template(x).xls
where x is 1,2,3 and so on.

Can someone help me to modify this code so it'll look through every
template(x).xls workbook in the same folder?

as an additonal question, when I use the below below on a new
worksheet, it starts at line 2, is there a way to start at line1 or
line 5?



Private Sub CommandButton1_Click()

    Dim wb As Workbook, ws As Worksheet, i As Integer
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\template1.xls")
    Set ws = wb.Sheets("Sheet1")
    Dim intRow As Integer
    intRow = 1

            Do While ws.Cells(4 + intRow, 1).Value <> ""
            i = i + 1
                proid = ws.Cells(4 + intRow, 1).Value
                pro = ws.Cells(4 + intRow, 2).Value
                uom = ws.Cells(4 + intRow, 3).Value
                qty = ws.Cells(4 + intRow, 4).Value
                ThisWorkbook.Sheets("GrandTotal").Range("a" & 1 +
i).End(xlUp).Offset(1, 0).Resize(, 4) = Array(proid, pro, uom, qty)
                intRow = intRow + 1
            Loop

    wb.Close savechanges:=False


    Set wb = Workbooks.Open(ThisWorkbook.Path & "\template2.xls")
    Set ws = wb.Sheets("Sheet1")
    intRow = 1

            Do While ws.Cells(4 + intRow, 1).Value <> ""
            i = i + 1
                proid = ws.Cells(4 + intRow, 1).Value
                pro = ws.Cells(4 + intRow, 2).Value
                uom = ws.Cells(4 + intRow, 3).Value
                ThisWorkbook.Sheets("GrandTotal").Range("a" & 1 +
i).End(xlUp).Offset(1, 0).Resize(, 4) = Array(proid, pro, uom, qty)
                intRow = intRow + 1
            Loop

    wb.Close savechanges:=False


    Set wb = Workbooks.Open(ThisWorkbook.Path & "\template3.xls")
    Set ws = wb.Sheets("Sheet1")
    intRow = 1

            Do While ws.Cells(4 + intRow, 1).Value <> ""
            i = i + 1
                proid = ws.Cells(4 + intRow, 1).Value
                pro = ws.Cells(4 + intRow, 2).Value
                uom = ws.Cells(4 + intRow, 3).Value
                ThisWorkbook.Sheets("GrandTotal").Range("a" & 1 +
i).End(xlUp).Offset(1, 0).Resize(, 4) = Array(proid, pro, uom, qty)
                intRow = intRow + 1
            Loop

    wb.Close savechanges:=False

End Sub
0
gjfeng (8)
6/20/2008 3:14:50 AM
excel 39879 articles. 2 followers. Follow

1 Replies
530 Views

Similar Articles

[PageSpeed] 41

If you know how many you need, you could use this:

Option Explicit
Private Sub CommandButton1_Click()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim i As Long
    Dim intRow As Long
    Dim wCtr As Long
    Dim TemplName As String
    Dim HowMany As Long
    
    Dim proid As Variant
    Dim pro As Variant
    Dim uom As Variant
    Dim qty As Variant
    
    TemplName = ThisWorkbook.Path & "\Template"
    HowMany = 3
        
    For wCtr = 1 To HowMany
        Set wb = Nothing
        On Error Resume Next
        Set wb = Workbooks.Open(TemplName & wCtr & ".xls")
        On Error GoTo 0
        
        If wb Is Nothing Then
            MsgBox "Template" & wCtr & " wasn't found"
        Else
            Set ws = Nothing
            On Error Resume Next
            Set ws = wb.Sheets("Sheet1")
            On Error GoTo 0
            
            If ws Is Nothing Then
                MsgBox "Sheet1 wasn't found in Template" & wCtr
            Else
                intRow = 1
                Do While ws.Cells(4 + intRow, 1).Value <> ""
                i = i + 1
                    proid = ws.Cells(4 + intRow, 1).Value
                    pro = ws.Cells(4 + intRow, 2).Value
                    uom = ws.Cells(4 + intRow, 3).Value
                    qty = ws.Cells(4 + intRow, 4).Value
                    ThisWorkbook.Sheets("GrandTotal") _
                        .Range("a" & 1 + i).End(xlUp).Offset(1, 0).Resize(, 4) _
                            = Array(proid, pro, uom, qty)
                    intRow = intRow + 1
                Loop
            End If

            wb.Close savechanges:=False
        End If
        
    Next wCtr
End Sub

If you don't know how many you need, then this will stop when it doesn't find
the first template###.

Option Explicit
Private Sub CommandButton1_Click()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim i As Long
    Dim intRow As Long
    Dim wCtr As Long
    Dim TemplName As String
    
    Dim proid As Variant
    Dim pro As Variant
    Dim uom As Variant
    Dim qty As Variant
    
    TemplName = ThisWorkbook.Path & "\Template"
    
    wCtr = 0
    Do
        wCtr = wCtr + 1
        
        Set wb = Nothing
        On Error Resume Next
        Set wb = Workbooks.Open(TemplName & wCtr & ".xls")
        On Error GoTo 0
        
        If wb Is Nothing Then
            MsgBox "Template" & wCtr & " wasn't found" & vbLf & "Quitting"
            Exit Do
        Else
            Set ws = Nothing
            On Error Resume Next
            Set ws = wb.Sheets("Sheet1")
            On Error GoTo 0
            
            If ws Is Nothing Then
                MsgBox "Sheet1 wasn't found in Template" & wCtr
            Else
                intRow = 1
                Do While ws.Cells(4 + intRow, 1).Value <> ""
                i = i + 1
                    proid = ws.Cells(4 + intRow, 1).Value
                    pro = ws.Cells(4 + intRow, 2).Value
                    uom = ws.Cells(4 + intRow, 3).Value
                    qty = ws.Cells(4 + intRow, 4).Value
                    ThisWorkbook.Sheets("GrandTotal") _
                        .Range("a" & 1 + i).End(xlUp).Offset(1, 0).Resize(, 4) _
                            = Array(proid, pro, uom, qty)
                    intRow = intRow + 1
                Loop
            End If

            wb.Close savechanges:=False
        End If
    Loop
End Sub

gjfeng@yahoo.com wrote:
> 
> As you can see the code below, everything is the same, except
> template(x).xls
> where x is 1,2,3 and so on.
> 
> Can someone help me to modify this code so it'll look through every
> template(x).xls workbook in the same folder?
> 
> as an additonal question, when I use the below below on a new
> worksheet, it starts at line 2, is there a way to start at line1 or
> line 5?
> 
> Private Sub CommandButton1_Click()
> 
>     Dim wb As Workbook, ws As Worksheet, i As Integer
>     Set wb = Workbooks.Open(ThisWorkbook.Path & "\template1.xls")
>     Set ws = wb.Sheets("Sheet1")
>     Dim intRow As Integer
>     intRow = 1
> 
>             Do While ws.Cells(4 + intRow, 1).Value <> ""
>             i = i + 1
>                 proid = ws.Cells(4 + intRow, 1).Value
>                 pro = ws.Cells(4 + intRow, 2).Value
>                 uom = ws.Cells(4 + intRow, 3).Value
>                 qty = ws.Cells(4 + intRow, 4).Value
>                 ThisWorkbook.Sheets("GrandTotal").Range("a" & 1 +
> i).End(xlUp).Offset(1, 0).Resize(, 4) = Array(proid, pro, uom, qty)
>                 intRow = intRow + 1
>             Loop
> 
>     wb.Close savechanges:=False
> 
>     Set wb = Workbooks.Open(ThisWorkbook.Path & "\template2.xls")
>     Set ws = wb.Sheets("Sheet1")
>     intRow = 1
> 
>             Do While ws.Cells(4 + intRow, 1).Value <> ""
>             i = i + 1
>                 proid = ws.Cells(4 + intRow, 1).Value
>                 pro = ws.Cells(4 + intRow, 2).Value
>                 uom = ws.Cells(4 + intRow, 3).Value
>                 ThisWorkbook.Sheets("GrandTotal").Range("a" & 1 +
> i).End(xlUp).Offset(1, 0).Resize(, 4) = Array(proid, pro, uom, qty)
>                 intRow = intRow + 1
>             Loop
> 
>     wb.Close savechanges:=False
> 
>     Set wb = Workbooks.Open(ThisWorkbook.Path & "\template3.xls")
>     Set ws = wb.Sheets("Sheet1")
>     intRow = 1
> 
>             Do While ws.Cells(4 + intRow, 1).Value <> ""
>             i = i + 1
>                 proid = ws.Cells(4 + intRow, 1).Value
>                 pro = ws.Cells(4 + intRow, 2).Value
>                 uom = ws.Cells(4 + intRow, 3).Value
>                 ThisWorkbook.Sheets("GrandTotal").Range("a" & 1 +
> i).End(xlUp).Offset(1, 0).Resize(, 4) = Array(proid, pro, uom, qty)
>                 intRow = intRow + 1
>             Loop
> 
>     wb.Close savechanges:=False
> 
> End Sub

-- 

Dave Peterson
0
petersod (12005)
6/20/2008 11:51:43 AM
Reply:

Similar Artilces:

Business Type Code Vs Industry
Hello, Can someone explain the difference between Business Type Code & Industry? What is the role or purpose of Business Type code. If anyone knows of any resources that could explain the intended purpose of this and some of the other fields on the account object such as Classification, and Category that would be great. Hi, It totally depends upon your business requirments. If you think some field is not required then just remove it or modify it to suit your requirments. There are many attributes of Account which are not even shown on Account Form by default but they are there in ...

Code Comment Web Report,
I have enabled VC++ XML comments in Visual Studio 2005. However, I do not see the "Build Comment Web Pages" under the Tools file menu (which my book says should be there--but the book was written for VS02). Did they get rid of Build Comment Web Pages in VS05, or simply move it? > I have enabled VC++ XML comments in Visual Studio 2005. However, I do not > see the "Build Comment Web Pages" under the Tools file menu (which my book > says should be there--but the book was written for VS02). Did they get rid > of Build Comment Web Pages in VS05, or simply ...

output to
I created a button to save a report in a designated folder. The date parameter is a box on the form the query for the report runs off of. I want to include that date field in my report so I know what parameters I ran the report on by looking at the contents of the folder. I tried to code the start date into my stOuputFile portion but didn't do it correctly. Here's my code so far for the button. Let me know if anything should be cleaned up as well. Thanks. Private Sub Cmd_MailEngineerRpt_Click() On Error GoTo Err_Cmd_MailEngineerRpt_Click Dim stDocName As String stD...

VB code
Hi all, I am trying to create a macro using VB. Here is what I want my macro to do : I have file1 and file 2 saved in each monthly folder like c:/month/file1.xle c:/month/file2.xle I have a spreadsheet like this A B C D E Date Unit No. Sale Amt Source1 Source2 9/4/2005 UN01 $2.00 6/8/2004 UN02 $3.00 10/5/2004 UN03 $5.00 My file1 like this colum A colum B Unit No Source1 Un02 10 Uni03 12 Now I need go to file1 to find data for Colum D(Source1) by using vlookup function based on the unit number then extrive the data to colum D and times 50%. So after I run the ma...

Looping through TextBoxes
I have a UserForm with an array of TextBoxes that allows the user to edit selected data arrays from a larger database. To load these TextBoxes I can use a brute force method: With UserForm1 .txBox1 = array(1) .txBox2 = array(2) etc but it would obviously be better to do this in a loop. My problem is I can’t figure how to synthesize the TextBox names so I can use a loop to functionally do: .txBoxn= array(n) Can someone tell me how to do this? -- Al_82 If you're in the userform_initialize event (or anywhere in the userform module), you could use: With Me...

creating links inside a workbook.
I would like to put a working table of contents into my workbook. In other words, I would like to list all of the sheet names on a master page and allow the user to jump to that page simply by clicking the page's name. Any suggestions? Please and Thank You!!!! Use the Hyperlink feature. Just do a Insert> HyperLink>. Choose place in this document. Then select the tab you want to link to. "Angelica" <Angelica@discussions.microsoft.com> wrote in message news:94B5487B-A816-4BE3-B43A-701863DCFE76@microsoft.com... >I would like to put a working table of content...

Modified Reports Fonts
We are running Great Plains 7.5 on Terminal Server 2000 and on client PCs running Windows XP Pro. From a Terminal Server install, user A has been printing a modified report (cash requirments) for a couple years with a readable font. Recently we installed GP on her local machine. Now when she prints, the font is somewhat readable but noticably different then the terminal server GP. She is using the same printer and print drivers from both locations. User B prints the same modified report from terminal server and from a local install and prints to the same printer as user A, but has ...

shared workbook issue
Hello All - I am using Excel 2007 and have a shared workbook that is also password protected. One user of the workbook attempted to save changes and received an error message that reads: "Caution: You are attempting to save a shared workbook that is also protected with a password. Portions of the file, including the change history, will not be encrypted. To help ensure the security of your file, unshare the workbook or delete the change history from the document. Do you want to save this file?" I would like to keep this as a shared workbook, so I attempted to delete t...

Smaller workbooks?
Hi. My Excel 2000 workbook has just increased in size from 1mb to just under 8mb !! I have added a few formulae and a long VBA macro. The workbook has 14 sheets, no graphics and quite a bit of conditional formatting. The VBA adds formulae to the various sheets on an 'as required' basis - if 30 rows are needed, then the macro adds formulae to about 20 columns on 30 rows. Thats all it does. I just did a bit more work to it and the size jumped.... Any suggestions on how to get it smaller again? Thanks. Jim Hi Jim, Does Ctrl+End properly identify your last cell or is it way down...

copy data from one worksheet to identical sheet in different workbook
I want to essentially sync the data between 2 identical worksheets in different workbooks. Essentially, I want to import and replace data in the second sheet with data from the first, is there a simple way to do this without deleting the worksheet and then copying the new sheet into the workbook? Thanks You can right-click on your source-sheetname tab, the shortmenu will reflect Copy/MoveSheet.... Select it and make 2 other choices: 1) Check to Create Copy box at bottom 2) From dropdown box at top of screen select an existing open workbook or select new-workbook. OK HTH "a...

password for workbook
Hello, How can i set the workbook so that when opened, a dialogu appears asking for password to open up the workbook before being abl to read or Read/write anything.... Thanks a lot From Joh -- Neo ----------------------------------------------------------------------- Neo1's Profile: http://www.excelforum.com/member.php?action=getinfo&userid=3032 View this thread: http://www.excelforum.com/showthread.php?threadid=53146 One simple way, although the password input is not masked '----------------------------------------------------------------- Private Sub Workbook_Open() '...

can send but can receive- event log shows loop within Exchange
Hi all, When I try to send email to my exchange 2003 server from an external email account I never get the email. I get the following error message in my event log. ------------------------ A non-delivery report with a status code of 5.3.5 was generated for recipient rfc822;adrown@[192.168.2.249] (Message-ID <200411090532.iA95WemV015823@gatekeeper.com>). Causes: A looping condition was detected. (The server is configured to route mail back to itself). If you have multiple SMTP Virtual Servers configured on your Exchange server, make sure they are defined by a unique incoming port and t...

Loop gone crazy
Howdy, Can someone tell me why this loop accepts any value rather than the set constants? Dim shp as Long Dim shpSw as Integer Do while shpSw = 0 shp = inputbox("Please enter a number:") if shp = 1 or 2 or 3 or 4 then shpSw =1 else Msgbox("Please enter a number from 1-4") end if Loop Should be a simple loop that if say "5" is entered will give the msgbox and loop but it is accepting 5 and setting my switch to 1. Thanks for the help in advance, Mjack -- mjack003 ------------------------------------------------------------------------ mjack003&#...

Help...Need to modify data within a column in a .csv file
I have been given a .csv file of several thousand rows, and I need to change column A of each. The brief cutout below shows column A of the first two rows. (I need to skip the first row, which is the headers.) Kinda clumsy to have such a wide column, but the application this file is to be fed after I change the contents requires all the data separated by double-quotes to be in the one column. Cell A2: 09/12/0509/25/05"1417385"121"307"111-11-1111"09/30/05"LASTNAME1 Cell A3: 09/12/0509/25/05"1417386"101"900000005"222-22-2222"09/30/05"...

Searching a Differnt worksheet in the same workbook.
So what I need to do is have a colum D that searches Sheet1, column E for a certain text string entered in a different sheet (either 2 or 3) column D. If they match I want the cell in column E, sheet 2 or 3 to return a text of "Found" and if there is no match I want the cell to be blank. I've been looking in these forums and have a feeling it can be done, I just can't figure out how. Thanks. ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~ View and post usenet messages directly from http://www.ExcelForum.com/ Dear Cre...

shared workbook opens slowly
I have a workbook that uses conditional formating etc has 60 worksheets one for each week and 8 for info for drop down lists and the size is 10 mb. I have shared it via a windows 2003 severer but it takes along time to open any thoughts as to what I may have done wrong Since you have 60 worksheets with conditional formatting and the same is used by many persons in sharing mode will make excel to open the file slowly. Try to Remove unwanted worksheets from your workbook and on daily basis or two days once Remove the sharing and give Cntrl+S and apply the sharing. While doing ...

Does any have any sample code for Store Manager Addins
I'd like to jump start some development efforts and would like to see some examples of how ADDINs have been used. Anything that hits the PurchaseOrder Table would be perfect.... My understanding is that samples are availble to certified partners at the PartnerSource web site: https://mbs.microsoft.com/partnersource/products/rms/documentation/installationsetupguides It is not clear to me if customers have direct access to it or not. "Espo" wrote: > I'd like to jump start some development efforts and would like to see some > examples of how ADDINs have been used...

On error displayes default error code instead of the specifyed one
Hi, I have added error handling code to my combo box. Private Sub searchName_AfterUpdate() ' Find the record that matches the control. Dim rs As Object On Error GoTo ERR_Handler Set rs = Me.Recordset.Clone rs.FindFirst "[sdutentId] = " & Str(Nz(Me![searchName], 0)) On Error GoTo 0 Exit Sub ERR_Handler: MsgBox "Please empty search box before continuing!" End Sub But it doesn't display the message in msgbox, it displayed default ms access error code. which is "The text you have entered isn't an item in the ...

Vendor Lookup Field with Modifier
I would like to modify the ap entry form and create 1 or 2mores field. This additional field will be used to track related party vendor number/name For example, the invoice is being paid to Vendor A. But because our invoice for Vendor A may be related to Vendor B, I would like to enter this info in the system. Currently, we just enter the related vendor ID in the note field. But due to the large number of related party transactions, the users are entering incorrect vendor numbers or they are not properly formatted , in the note field. This makes it difficult to analyze related party...

Escape codes embedded in XML
Hello, I have built an XMLDocument object instance and I get the following string when I examine the InnerXml property: <?xml version=\"1.0\"?><ROOT><UserData UserID=\"2282\"><Tag1 QID=\"55111\"><Tag2 AID=\"5511101\"></Tag2></Tag1><Tag1 QID=\"55112\"><Tag2 AID=\"5511217\"></Tag2></Tag1><Tag1 QID=\"5512282\"><Tag2 AID=\"551228206\"></Tag2></Tag1><Tag1 QID=\"55114\"><Tag2 AID=\"5511406\"></Ta...

AutoPublish code
Hi, I'm looking for an autopublish product for a customer of mine. I know of one, but I'm trying to create a list of options for my customer, so if you know of one, can you please reply to this post with details. -- Regards, Ben. I've seen a couple folks develop macros to publish all projects. Not sure if that's what you're looking for.... - Andrew Lavinsky Blog: http://blogs.catapultsystems.com/epm > Hi, I'm looking for an autopublish product for a customer of mine. I > know of one, but I'm trying to create a list of options for m...

Saving workbook #2
We are sharing some excel books on netwrok by using several "my briefcase" linking to one master file. We cannot modify the file and update to the master file at the same time - as the computer refuse to merge them together. Is there any method that it can go real multiuser. Hi you may try the following: sub save_with_cell() Dim fname fname = worksheets("sheet1").range("A1").value fname = fname & ".xls" ActiveWorkbook.SaveAs Filename:=fname end sub You should add some error checking to this (does the files exist, etc.) -- Regards Fr...

code to change a form's allows?
I am wondering what the code syntax is to tweak a form's allows? Allows deletions? Allows Adds? etc I know how to do it in the right-clicked form properties manually, but I need it to be based on conditions. Reason I need this is because I have one form that all users open. Depending on their window's username, I have a security table that tells me what role I want them to have in the database. Depending on their role, some users have more rights than others on this form. I want to adjust the form to allow additions for some users, but not others. Me.AllowAdditions = Fals...

Modify Appointment Status Code attribute
Hello, Does anyone know how I can modify the pick list values that is for the Status Code attribute in the Appointment Entity. This is the pick list that appears when a user clicks on Actions->Close Appointment. All I can use is Completed or Canceled. However, I would like to add more to the list. When I open the attribute, everything is greyed out and I cannot modify this. Please advise. Thanks Hi Daryl this field is locked because it is a system attribute, and i do not know of any supported ways to customize/change values in this attribute. Regards Leon Agerlin "daryl&...

Print Workbook
Hi, I've looked around and seen one answer to this that suggests a macro with a button, but I don't want to go down that route. So - how do I make excel print the whole workbook when print is selected? I have a workbook with 3 worksheets, and the users will need to print off all 3 to return to me. Rather than risk them print off only one and return that, if it auto prints all 3 I should guarantee that i get all 3 returned. Thanks, You might try this. Put this code in your workbook's ThisWorkbook module: Private Sub Workbook_BeforePrint(Cancel As Boolean) Worksheets....