Proofread my code

R

Ray

Hi -

I need to 'consolidate' data into one Master Workbook -- my current
code is below. The data currently sits in approx 30 workbooks and is
spread across a number of worksheets within each WB. All WB are set
up exactly the same way -- same sheet names, etc. The Master WB also
has the same Sheet names (to keep things simple).

My code worked fine when just hitting one worksheet within each WB.
However, when I modified the code to pull from all of the sheets, it
didn't work at all! My modification was to activate the vArr code and
change all references to the single worksheet to use the 'ws'
reference. When I run the code now, the first WB opens and then the
code stops.

What's causing this and how do I fix it?

A couple of other small things aren't working -- there's code to
isolate the store number from the name of each target WB and insert it
into Column A. It should put this store number next to EACH ROW that
is transferred, but it currently just puts it in the first row.

When all data has been pulled from the target WBs, I want all blank
rows to be deleted from each data tab in the Master WB. A blank row
is any row where cells Ax & Bx (where x is row #) are blank.

Any help is greatly appreciated ... here's my current code:
Sub Example2()
Dim MyPath, getstore As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount, x As Long
Dim Fnum, i As Long
Dim mybook As Workbook
Dim basebook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim ws As Worksheet

MyPath =" \\server\folder1\folder2\folder3\"

' the following are sheets within each target WB
vArr = Array("Sales Act", "Hours Act", "Sales LY", "Sales Goal",
"Hours LY", "Hours Goal", "Sales Forecast", "Hours Forecast")

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xls")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

On Error GoTo CleanUp

Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set basebook = ThisWorkbook
'clear all cells on the first sheet
basebook.Worksheets("Hours Act").Cells.Clear
rnum = 2

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Loop through all files in the array(myFiles) and selected sheets
in array(vArr)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
For i = LBound(vArr) To UBound(vArr)
Set sh = Worksheets(vArr(i))
Set sourceRange = mybook.sh.UsedRange
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.sh.Range("B" & rnum)

' Isolates the store number from the workbook name
getstore = Replace(mybook.Name, "Weekly report sales &
hours_", "")
getstore = Replace(getstore, ".xls", "")
basebook.sh.Cells(rnum, "A").Value = getstore


With sourceRange
Set destrange = basebook.sh.Cells(rnum,
"B").Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
Next

rnum = rnum + SourceRcount
mybook.Close savechanges:=False
Next Fnum
End If

CleanUp:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
 
J

Jim Cone

Some suggestions...
Declare the vArr and sh variables.

Change the sh and destrange references as follows...
For i = LBound(vArr) To UBound(vArr)
Set sh = myBook.Worksheets(vArr(i))
Set sourceRange = sh.UsedRange
SourceRcount = sourceRange.Rows.Count
Set destrange = baseBook.Worksheets(sh.Name).Range("B" & rnum)

Change all other references to the basebook sheet as above.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


"Ray" <[email protected]>
wrote in message
Hi -
I need to 'consolidate' data into one Master Workbook -- my current
code is below. The data currently sits in approx 30 workbooks and is
spread across a number of worksheets within each WB. All WB are set
up exactly the same way -- same sheet names, etc. The Master WB also
has the same Sheet names (to keep things simple).

My code worked fine when just hitting one worksheet within each WB.
However, when I modified the code to pull from all of the sheets, it
didn't work at all! My modification was to activate the vArr code and
change all references to the single worksheet to use the 'ws'
reference. When I run the code now, the first WB opens and then the
code stops.

What's causing this and how do I fix it?

A couple of other small things aren't working -- there's code to
isolate the store number from the name of each target WB and insert it
into Column A. It should put this store number next to EACH ROW that
is transferred, but it currently just puts it in the first row.

When all data has been pulled from the target WBs, I want all blank
rows to be deleted from each data tab in the Master WB. A blank row
is any row where cells Ax & Bx (where x is row #) are blank.

-snip-
 
D

Dave Peterson

Untested, but it did compile:

Option Explicit
Sub Example2()
Dim MyPath, getstore As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount, x As Long
Dim Fnum, i As Long
Dim mybook As Workbook
Dim basebook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim ws As Worksheet
Dim vArr As Variant
Dim sh As Worksheet 'in each workbook
Dim bbSh As Worksheet 'in basebook

MyPath = " \\server\folder1\folder2\folder3\"

'the following are sheets within each target WB
vArr = Array("Sales Act", "Hours Act", "Sales LY", _
"Sales Goal", "Hours LY", "Hours Goal", _
"Sales Forecast", "Hours Forecast")

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xls")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

On Error GoTo CleanUp

Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set basebook = ThisWorkbook
'clear all cells on the first sheet
basebook.Worksheets("Hours Act").Cells.Clear
rnum = 2

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Loop through all files in the array(myFiles) and selected sheets
'in array(vArr)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
For i = LBound(vArr) To UBound(vArr)

Set sh = mybook.Worksheets(vArr(i))
Set bbSh = basebook.Worksheets(vArr(i))

Set sourceRange = sh.UsedRange
SourceRcount = sourceRange.Rows.Count

Set destrange = bbSh.Range("B" & rnum)

' Isolates the store number from the workbook name
getstore = Replace(mybook.Name, _
"Weekly report sales & hours_ ", "")
getstore = Replace(getstore, ".xls", "")
bbSh.Cells(rnum, "A").Value = getstore

With sourceRange
Set destrange = bbSh.Cells(rnum, "B") _
.Resize(.Rows.Count, .Columns.Count)
End With

destrange.Value = sourceRange.Value
Next i

rnum = rnum + SourceRcount
mybook.Close savechanges:=False
Next Fnum
End If

CleanUp:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
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

Similar Threads


Top