LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
Ray Ray is offline
external usenet poster
 
Posts: 267
Default Proofread my code

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

 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
split post code (zip code) out of cell that includes full address Concord Excel Discussion (Misc queries) 4 October 15th 09 06:59 PM
Prompt for Korean proofread Mats Samson Excel Discussion (Misc queries) 0 November 15th 07 08:01 PM
Shorten code to apply to all sheets except a few, instead of individually naming them, and later adding to code. Corey Excel Programming 3 December 11th 06 05:14 AM
Protect Sheet with code, but then code will not Paste error. How do i get around this. Please read for explainations.... Corey Excel Programming 4 November 25th 06 04:57 AM
Excel code convert to Access code - Concat & eliminate duplicates italia Excel Programming 1 September 12th 06 12:14 AM


All times are GMT +1. The time now is 06:51 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"