Modify This Code for WorkBook Loop

G

gjfeng

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
 
D

Dave Peterson

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top