PDA

View Full Version : Solved: VBA Code, who can help?



MPDK166
03-25-2011, 08:01 AM
I am creating a workbook (week report) which must be filled with data from other workbooks (day reports). The data I want to retrieve from the different day reports, must be set in the week report.

This is the script, i have got this far... There are still a lot of questions and challenges for me...


Option Explicit

Sub GetData()

Dim Extra As Integer
Dim cRange As Range
Dim FileValue

For Each cRange In Range("L2:R2")
For Extra = 0 To 6

FileValue = cRange
Dim FilePath$, Row&, Column&, Address$


Dim FileName$
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

Dim sDay$
Dim sMonth$
Dim sYear$
Dim dtmDate As Date
dtmDate = cRange.Value
sDay = Format(Day(dtmDate), "00")
sMonth = Format(Month(dtmDate), "00")
sYear = Format(Year(dtmDate), "0000")

FileName$ = sDay & sMonth & sYear & ".xls"

Const SheetName$ = "Blad1"
Const NumRows& = 10
Const NumColumns& = 1
FilePath = fso.GetFolder(ThisWorkbook.path & "\..").path & "\Test1\"

DoEvents
Application.ScreenUpdating = False
If Dir(FilePath & FileName) = Empty Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Exit Sub
End If

Dim cRow As Range
Dim CellValue
For Each cRow In Range("A1:A5, A8:A10")

Address = cRow.Address
CellValue = cRow.Address
Worksheets("Blad2").Range(CellValue).Offset(0, 1).Offset(0, Extra) = GetData(FilePath, FileName, SheetName, Address)
Next cRow
ActiveWindow.DisplayZeros = False

Next Extra
Next cRange
End Sub


Private Function GetData(path, file, sheet, Address)
Dim Data$
Data = "'" & path & "[" & file & "]" & sheet & "'!" & Range(Address).Range("A1").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function

nepotist
03-25-2011, 08:23 AM
Please use the VBA tags "Option Explicit

Sub GetData()

Dim Extra As Integer
Dim cRange As Range
Dim FileValue

For Each cRange In Range("L2:R2")
For Extra = 0 To 6

FileValue = cRange
Dim FilePath$, Row&, Column&, Address$


Dim FileName$
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

Dim sDay$
Dim sMonth$
Dim sYear$
Dim dtmDate As Date
dtmDate = cRange.Value
sDay = Format(Day(dtmDate), "00")
sMonth = Format(Month(dtmDate), "00")
sYear = Format(Year(dtmDate), "0000")

FileName$ = sDay & sMonth & sYear & ".xls"

Const SheetName$ = "Blad1"
Const NumRows& = 10
Const NumColumns& = 1
FilePath = fso.GetFolder(ThisWorkbook.path & "\..").path & "\Test1\"

DoEvents
Application.ScreenUpdating = False
If Dir(FilePath & FileName) = Empty Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Exit Sub
End If

Dim cRow As Range
Dim CellValue
For Each cRow In Range("A1:A5, A8:A10")

Address = cRow.Address
CellValue = cRow.Address
Worksheets("Blad2").Range(CellValue).Offset(0, 1).Offset(0, Extra) = GetData(FilePath, FileName, SheetName, Address)
Next cRow
ActiveWindow.DisplayZeros = False

Next Extra
Next cRange
End Sub


Private Function GetData(path, file, sheet, Address)
Dim Data$
Data = "'" & path & "[" & file & "]" & sheet & "'!" & Range(Address).Range("A1").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function". Where do you need help?

MPDK166
03-25-2011, 08:41 AM
In all the loop parts...

Currently the data which is written away in the main workbook (week report) is the data which is retrieved from the last file.

The range (A1:A5, A8:A10) from the last file ("R2") is placed in the week report range (B1:H5, B8:B10). The situation i want is the next:

Range (A1:A5, A8:A10) from file ("L2") must written in the workbook (week report) range(B1:B5, B8:B10).
Range (A1:A5, A8:A10) from file ("M2") must written in the workbook (week report) range(C1:C5, C8:C10).
etc...

BTW: This script is placed in the workbook (week report)

I hope this clear, otherwise I can upload my files!

nepotist
03-25-2011, 10:18 AM
For Each cRow In Range("A1:A5, A8:A10")

Address = cRow.Address ' You dont need this line
CellValue = cRow.Address
Worksheets("Blad2").Range(CellValue).Offset(0, 1).Offset(0, Extra) = GetData(FilePath, FileName, SheetName, Address)
Next cRow
ActiveWindow.DisplayZeros = False

Next Extra

The above loop has a undefined variable Address. Could you upload a sample to test this.

MPDK166
03-25-2011, 11:12 AM
I tested it and you do need this line!

Attached my test samples!

In the folder Test there is the main file (test.xls) see worksheet2 -- the button.
In this sheet I want the results from the files in folder Test1
The data (A1:A5, A8:A10) from the file 12122011.xls must be set at test.xls (B1:B5, B8:B10).
The data (A1:A5, A8:A10) from the file 13122011.xls must be set at test.xls (C1:C5, C8:C10).

nepotist
03-25-2011, 11:44 AM
There is no Test.xls document in the zip file

MPDK166
03-25-2011, 11:45 AM
The test.xls is in the folder Test

mdmackillop
03-25-2011, 02:45 PM
Remove the For Extra loop and use this instead


Next cRow
ActiveWindow.DisplayZeros = False

Extra = Extra + 1
Next cRange
End Sub

MPDK166
03-25-2011, 03:02 PM
If I cancel the loop, the data will only be placed in the B column and nothing in the C column.

Also my other problem is still there, the data of the 2nd files (13122011.xls) is set and the data of the 1st file (12122011.xls) is ignored.

This is the situation i want:

Range (A1:A5, A8:A10) from file ("L2" --> 12122011) must written in the workbook (Test.xls) on the place range(B1:B5, B8:B10).
Range (A1:A5, A8:A10) from file ("M2" --> 13122011) must written in the workbook (test.xls) on the place range(C1:C5, C8:C10).

mdmackillop
03-25-2011, 03:07 PM
Did you try it?

MPDK166
03-25-2011, 03:08 PM
Yes!

mdmackillop
03-25-2011, 03:29 PM
Strange, This what I get

MPDK166
03-25-2011, 03:35 PM
Can you upload your sample? Maybe I did something wrong...

btw does it make a difference of the version of excel? I use 2003!

mdmackillop
03-25-2011, 03:40 PM
Sure

MPDK166
03-25-2011, 03:59 PM
Problem solved!!!!

Thanks!