For Each is returning data outside the defined range

[msquared99]

OK, I have this code that loops through several workbooks in a folder. The search range is dynamic. The issue is that the data returned from the SourceRange is coming from outside the SourceRange.

The way each workbook is laid out is there is a date in column A that begins in row 24. This range is dynamic and can span to row 30 something or more. Also, below this range there are 4 blank rows then more dates that would overlap the SourceRange.

When the matching date is found I am returning cell A2, which has the name of the workbook in it, and cells from columns A (matching date), G ($ value), and I ($ value).

An example of what is happening with workbooks that have a matching date:

Match workbook 1:
SourceRange: A24:I33
Return cells are in row 52, the date does not match.

Match workbook 2:
SourceRange: A24:I34
Return cells are in row 56, the date does not match.

Match workbook 3:
SourceRange: A24:I35
Return cells are in row 50, the date does not match.

Option Explicit
Sub ExtractionMacro()
  
  Dim SummarySheet As Worksheet
  Dim FolderPath As String
  Dim NRow As Long, LastRow As Long
  Dim FileName As String
  Dim WorkBk As Workbook
  Dim DestRange As Range, FindRange As Range, i As Range, SourceRange As Range
  Dim FindVal As Date
  
  'Enter a date
  FindVal = Application.InputBox("Please enter a date as MM/DD/YYYY.", "Macro Canceled")
  If FindVal = False Then
  MsgBox "Macro was cancelled.", 64, "Cancel was clicked."
  Exit Sub
  End If
  
  ' Create a new workbook and set a variable to the first sheet.
  Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
  
  ' This is the folder path to point to the files you want to use.
  FolderPath = "C:\Test Files\"
  
  ' NRow keeps track of where to insert new rows in the destination workbook.
  NRow = 1
  
  ' Call Dir the first time, pointing it to all Excel files in the folder path.
  FileName = Dir(FolderPath & "*.xl*")
  
  ' Loop until Dir returns an empty string.
  Do While FileName <> ""
  ' Open a workbook in the folder
  Set WorkBk = Workbooks.Open(FolderPath & FileName)
  LastRow = WorkBk.Worksheets(1).Range("A24").End(xlDown).Row
  
  
  ' Set the source range to be A24 through I and LastRow.
  Set SourceRange = WorkBk.Worksheets(1).Range("A24:I" & LastRow)
  
  
  ' Set the destination range to start at column B and
  ' be the same size as the source range.
  
  Set DestRange = SummarySheet.Range("B" & NRow)
  
  
  ' Copy the values from the source to the destination.
  For Each i In SourceRange
  If i.Value = FindVal Then
  'Set the cell in column A to be the file name.
  DestRange.Cells(NRow, 1).Value = WorkBk.Worksheets(1).Cells(2, 1).Value
  DestRange.Cells(NRow, 2).Value = SourceRange.Cells(i.Row, 1).Value
  DestRange.Cells(NRow, 3).Value = SourceRange.Cells(i.Row, 7).Value
  DestRange.Cells(NRow, 4).Value = SourceRange.Cells(i.Row, 9).Value
  NRow = NRow + 1
  
  End If
  Next
  
  
  ' Close the source workbook without saving changes.
  WorkBk.Close savechanges:=False
  
  ' Use Dir to get the next file name.
  FileName = Dir()
  LastRow = Empty
  
  Loop
  
  ' Call AutoFit on the destination sheet so that all
  ' data is readable.
  SummarySheet.Columns.AutoFit
End Sub

 

[NARAYANK991]

Hi ,

The problem is your usage of Cells(i.Row,1) ; a construct such as :

SourceRange.Cells(1,1)

will return the first cell in SourceRange.

When you use i.Row , you are using the value 24 for the first cell in the range ; thus , instead of getting the value from row 24 , you are getting it from a different row altogether.

Narayan

 

[msquared99]

That is what I thought may be the issue. What stumped me was I had this code in one of the workbooks to test it and it worked fine. But, when putting it into the code to loop through several workbooks it would not work.

Option Explicit
Sub SumDateData()

  Dim DataSheet As Worksheet, SumSheet As Worksheet
  Dim LastRow As Long, iRow As Long
  Dim FindRange As Range, i As Range
  Dim FindVal As Date
  
  Set DataSheet = Worksheets("LM 300") 'Each workbook will have 1 worksheet with a different name.
  Set SumSheet = Worksheets("Summary") 'The Summary workbook will be a separate workbook form the macro workbook.
  
  FindVal = InputBox("Enter a date as MM/DD/YYYY")
  If FindVal = False Then
  MsgBox "Macro was cancelled.", 64, "Cancel was clicked."
  Exit Sub
  End If
  
  With DataSheet
  
  LastRow = DataSheet.Range("A24").End(xlDown).Row
  
  Set FindRange = DataSheet.Range("A24:I" & LastRow)
  
  For Each i In FindRange
  If i.Value = FindVal Then
  SumSheet.Cells(1 + iRow, 1).Value = DataSheet.Cells(i.Row, 1).Value
  SumSheet.Cells(1 + iRow, 2).Value = DataSheet.Cells(i.Row, 7).Value
  SumSheet.Cells(1 + iRow, 3).Value = DataSheet.Cells(i.Row, 9).Value
  
  iRow = iRow + 1
  End If
  Next
  End With
  
  FindVal = Empty
  
  'Debug.Print FindRange

End Sub

So, what construct would I use to return the matching cell?

 

[NARAYANK991]

Hi ,

The point is that where ever you find a match , you need to see where this row is in relation to the first row of the range , which is row 24.

Thus , instead of using Cells(i.Row , ...) , you should use :

Cells(i.Row - 24 + 1 , ...)

so , if the first row is a match , then i.Row returns 24 , and after subtracting 24 and adding 1 , we get Cells(1 , ...) ; the matching row is row #32 , we will be actually using Cells(9 , ...) since the match is in the 9th row.

Narayan

 

[msquared99]

Thanks Narayan!

It worked perfect!