Compare dtmDate with a value in column A

[MPDK166]

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]

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]

Please use meaningful titles for your questions. Most posts are for VBA Help!

[MPDK166]

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.

[Bob Phillips]

Don't understand.

[MPDK166]

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]

Anybody some suggestions???