MPDK166
03-28-2011, 02:22 AM
I want to create some VBA code but need some help...
This is the code i want:
Dim dtmDate As Date
dtmDate = DateRange.Value
Dim cRow As Range
IF dtmDate = Column(A) Then 'How can I compare dtmDate with a value in column A
Get RowNumber 'How TO???
For Each cRow In Range("B+RowNumber:AB+RowNumber")
Address = cRow.Address
Worksheets("VC").Range(B4:AB4).Offset(Extra,0) = GetData(FilePath, FileName, SheetName, Address)
Next cRow
Extra = Extra + 1
Exit Sub
End If
BTW this is a part of my code!
Bob Phillips
03-28-2011, 04:17 AM
Dim dtmDate As Date
Dim cRow As Range
Dim Rownum As Long
dtmDate = DateRange.Value
On Error Resume Next
Rownum = Application.Match(CLng(dtmDate), Columna("A"), 0)
On Error Goto 0
If Rownum > 0 Then
For Each cRow In Range("B" & Rownum & ":AB" & Rownum)
Address = cRow.Address
Worksheets("VC").Range(B4:AB4).Offset(Extra,0) = GetData(FilePath, FileName, SheetName, Address)
Next cRow
Extra = Extra + 1
Exit Sub
End If
mdmackillop
03-28-2011, 04:44 AM
Please use meaningful titles for your questions. Most posts are for VBA Help!
MPDK166
03-28-2011, 07:58 AM
Hi,
It is not giving the results I want. In de loop part of Voorcalculation the results I want to retrieve are not set in the Sheet "VC" cells (B4: AB4).offset(extra,0). I changed the script you gave me a bit, because I didn't worked is I wanted...
Sub GetAllData()
Dim Extra As Integer
Dim DateRange As Range
Dim FileValue
Dim Rownum As Long
For Each DateRange In Range("A5:A11")
FileValue = DateRange
Dim FilePath$, Row&, Column&, Address$
'change constants & FilePath below to suit
'**************************************
Dim FileName$
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim sDay$
Dim sMonth$
Dim sYear$
Dim dtmDate As Date
dtmDate = DateRange.Value
sDay = Format(Day(dtmDate), "00")
sMonth = Format(Month(dtmDate), "00")
sYear = Format(Year(dtmDate), "0000")
FileName$ = sDay & sMonth & sYear & ".xls"
Const SheetName$ = "Voorblad"
FilePath = fso.GetFolder(ThisWorkbook.path & "\..").path & "\Urenregistratie\" & sMonth & "\"
'***************************************
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 CellValue
Dim cRow As Range
'Security Loop
For Each cRow In Range("B3:B16, B19:B20, B23:B35")
Address = cRow.Address
CellValue = cRow.Address
Worksheets("Sec").Range(CellValue).Offset(0, 1).Offset(0, Extra) = GetData(FilePath, FileName, SheetName, Address)
Next cRow
'Lost & Found Loop
For Each cRow In Range("C4:C16")
Address = cRow.Address
CellValue = cRow.Address
Worksheets("L&F").Range(CellValue).Offset(0, 0).Offset(0, Extra) = GetData(FilePath, FileName, SheetName, Address)
Next cRow
'Regulatie Loop
For Each cRow In Range("D4:D16")
Address = cRow.Address
CellValue = cRow.Address
Worksheets("Reg").Range(CellValue).Offset(0, -1).Offset(0, Extra) = GetData(FilePath, FileName, SheetName, Address)
Next cRow
'Bagagedepot Loop
For Each cRow In Range("E4:E16")
Address = cRow.Address
CellValue = cRow.Address
Worksheets("BD").Range(CellValue).Offset(0, -2).Offset(0, Extra) = GetData(FilePath, FileName, SheetName, Address)
Next cRow
'Ticket Reading Loop
For Each cRow In Range("F4:F16, F19:F20")
Address = cRow.Address
CellValue = cRow.Address
Worksheets("TR").Range(CellValue).Offset(0, -3).Offset(0, Extra) = GetData(FilePath, FileName, SheetName, Address)
Next cRow
'HTM Loop
For Each cRow In Range("G4:G16")
Address = cRow.Address
CellValue = cRow.Address
Worksheets("HTM").Range(CellValue).Offset(0, -4).Offset(0, Extra) = GetData(FilePath, FileName, SheetName, Address)
Next cRow
'Calamiteiten AAS Loop
For Each cRow In Range("H4:H16")
Address = cRow.Address
CellValue = cRow.Address
Worksheets("AAS").Range(CellValue).Offset(0, -5).Offset(0, Extra) = GetData(FilePath, FileName, SheetName, Address)
Next cRow
'D-Icing Loop
For Each cRow In Range("I4:I16")
Address = cRow.Address
CellValue = cRow.Address
Worksheets("D-I").Range(CellValue).Offset(0, -6).Offset(0, Extra) = GetData(FilePath, FileName, SheetName, Address)
Next cRow
'Porter Service Loop
For Each cRow In Range("J4:J16")
Address = cRow.Address
CellValue = cRow.Address
Worksheets("PS").Range(CellValue).Offset(0, -7).Offset(0, Extra) = GetData(FilePath, FileName, SheetName, Address)
Next cRow
'Voorcalculatie Loop
On Error Resume Next
Rownum = Application.Match(CLng(dtmDate), Columns("A"), 0)
On Error GoTo 0
If dtmDate = Cells(1, Rownum) Then
For Each cRow In Range("B" & Rownum & ":AB" & Rownum)
Address = cRow.Address
SheetName = "VC"
Worksheets("VC").Range("B4:AB4").Offset(Extra, 0) = GetData(FilePath, FileName, SheetName, Address)
Next cRow
Exit Sub
End If
ActiveWindow.DisplayZeros = False
Extra = Extra + 1
Next DateRange
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
The data I want to get is in a file different file (btw: for all the other parts it works), the only difference is that this data comes from a different sheet.
The criteria of query i want is still the same:
If dtmDate = a value in column A (can be on any row) then
get the rownumber and data (range(B:AB))
and set the data in the worksheet I want.
MPDK166
03-28-2011, 11:42 AM
I want to get data from a file (e.g. 21032011.xls), sheet (VC).
The data must be set at the main file, sheet(VC).
If the variable dtmDate (main file) is equal to a value (21032011.xls) in column A (can be at any row). Then I want to want set the data of that row (Range(B+rownumber:AB+rownumber)in the main file (sheet "VC" range(B4:AB4)).
I hope this is clear enough.
MPDK166
03-29-2011, 12:30 AM
Anybody some suggestions???
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.