Finding date in range of cells

[westwegoman]

I have a workbook that opens another workbook and is supposed to find every row containing a certain date and then copy cells related to the row that contains the date.. The macro that I have been using has been working for over ten years. It seems to have stopped working after we upgraded to Windows 11 with Office 2016.

The column that it looks in contains dates and times in five minute intervals and may contain an entire month of data. It worked for many years but has now decided to basically copy every row in the workbook since the upgrade.

Sub GetFlowData()
'this macro pulls data from plant trend files to calculate metered flows leaving plants


Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Do you really want to continue??"    ' Define message.
Style = vbOKCancel ' Define buttons.
Title = "Retrieve flow Data"    ' Define title.
Help = "DEMO.HLP"    ' Define Help file.
Ctxt = 1000    ' Define topic
        ' context.
        ' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
1 If Response = vbOK Then GoTo 9 Else: GoTo 999  ' User chose No.


9  Worksheets("TotFinFlow").Select
    Range("AC42:AC9050").ClearContents
    Range("AE42:AF9050").ClearContents
    Range("AH42:AI9050").ClearContents
    Range("AL42:AL9050").ClearContents

    Dim SYear As String, MDate As Date, Drive1 As String, Drive2 As String
   

    Drive1 = Trim(Workbooks("PumpSheetCalculator.xls").Sheets("Sheet1").Cells(120, "H")) 'P3
    Drive2 = Trim(Workbooks("PumpSheetCalculator.xls").Sheets("Sheet1").Cells(119, "H")) 'P2
    Folder = Trim(Workbooks("PumpSheetCalculator.xls").Sheets("Sheet1").Cells(121, "H")) 'Lookout folder
    SYear = Trim(Sheets("Sheet1").Cells(50, "I")) 'Defines the year folder
    MonthNum = Trim(Sheets("Sheet1").Cells(48, "I"))
    MonthDay = Trim(Sheets("Sheet1").Cells(49, "I"))
    MDate = Trim(Sheets("Sheet1").Cells(5, "C"))
           
    'ActiveWindow.WindowState = xlMinimized
   
    If MonthNum = 1 Then FMonth = "Jan"
     If MonthNum = 2 Then FMonth = "Feb"
     If MonthNum = 3 Then FMonth = "Mar"
     If MonthNum = 4 Then FMonth = "Apr"
     If MonthNum = 5 Then FMonth = "May"
     If MonthNum = 6 Then FMonth = "Jun"
     If MonthNum = 7 Then FMonth = "Jul"
     If MonthNum = 8 Then FMonth = "Aug"
     If MonthNum = 9 Then FMonth = "Sep"
     If MonthNum = 10 Then FMonth = "Oct"
     If MonthNum = 11 Then FMonth = "Nov"
     If MonthNum = 12 Then FMonth = "Dec"
   
    P3PlantFile = Drive1 + Folder + SYear + "\" + FMonth + "\ebtrends.csv"
   
    Application.DisplayAlerts = False
    Workbooks.Open Filename:=P3PlantFile, ReadOnly:=True
    Windows("ebtrends.csv").Activate
    'ActiveWindow.WindowState = xlMinimized
    Worksheets("EBTrends").Select
   
    StartFlag = 0
    Brow = 1
    Erow = 0
For I = 2 To 10000

If Sheets("ebtrends").Cells(I, "A") = MDate And StartFlag = 0 Then
                Sheets("ebtrends").Cells(I, "A").Select
                Brow = ActiveCell.Row
                StartFlag = 1
                End If

If Sheets("ebtrends").Cells(I, "A") = "" Or Sheets("ebtrends").Cells(I, "A") = MDate + 1 And StartFlag = 1 Then
                Sheets("ebtrends").Cells(I, "A").Select
                Erow = ActiveCell.Row - 1
                GoTo 5
                End If
              
    Next I
   
   
5    Range(Cells(Brow, "C"), Cells(Erow, "C")).Select
    Selection.Copy
   
    Windows("PumpSheetCalculator.xls").Activate
    Worksheets("TotFinFlow").Select
    Range("AC42").Select
   
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Range("A1").Select
       
        Windows("ebtrends.csv").Activate
   
    Range(Cells(Brow, "A"), Cells(Erow, "A")).Select 'Times
    Selection.Copy
   
    Windows("PumpSheetCalculator.xls").Activate
    Worksheets("TotFinFlow").Select
    Range("AL42").Select
   
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
       
    Windows("ebtrends.csv").Activate
    '''''''
    Range(Cells(Brow, "D"), Cells(Erow, "D")).Select 'P3 Pressure
    Selection.Copy
   
    Windows("PumpSheetCalculator.xls").Activate
    Worksheets("TotFinFlow").Select
    Range("AI42").Select
   
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Range("A1").Select
    Windows("ebtrends.csv").Activate
    '''''''''
    ActiveWindow.WindowState = xlMaximized
   ActiveWorkbook.Close savechanges = False
Windows("PumpSheetCalculator.xls").Activate



    'ActiveWindow.WindowState = xlMinimized
   
    If MonthNum = 1 Then FMonth = "Jan"
     If MonthNum = 2 Then FMonth = "Feb"
     If MonthNum = 3 Then FMonth = "Mar"
     If MonthNum = 4 Then FMonth = "Apr"
     If MonthNum = 5 Then FMonth = "May"
     If MonthNum = 6 Then FMonth = "Jun"
     If MonthNum = 7 Then FMonth = "Jul"
     If MonthNum = 8 Then FMonth = "Aug"
     If MonthNum = 9 Then FMonth = "Sep"
     If MonthNum = 10 Then FMonth = "Oct"
     If MonthNum = 11 Then FMonth = "Nov"
     If MonthNum = 12 Then FMonth = "Dec"
   
    FPPlantFile = Drive2 + Folder + SYear + "\" + FMonth + "\ebtrends.csv"
    Workbooks.Open Filename:=FPPlantFile, ReadOnly:=True
    Windows("ebtrends.csv").Activate
    'ActiveWindow.WindowState = xlMinimized
    Worksheets("EBTrends").Select
    StartFlag = 0
    Brow = 1
    Erow = 0
For I = 2 To 10000

If Sheets("ebtrends").Cells(I, "A") = MDate And StartFlag = 0 Then
                Sheets("ebtrends").Cells(I, "A").Select
                Brow = ActiveCell.Row
                StartFlag = 1
                End If

If Sheets("ebtrends").Cells(I, "A") = "" Or Sheets("ebtrends").Cells(I, "A") = MDate + 1 And StartFlag = 1 Then
                Sheets("ebtrends").Cells(I, "A").Select
                Erow = ActiveCell.Row - 1
                GoTo 105
                End If
              
    Next I
   
   
105    Range(Cells(Brow, "W"), Cells(Erow, "X")).Select
    Selection.Copy
   
    Windows("PumpSheetCalculator.xls").Activate
    Worksheets("TotFinFlow").Select
    Range("AE42").Select
   
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        'Range("A1").Select
       
    '''''''
    Windows("ebtrends.csv").Activate
   
    ''''''
    Range(Cells(Brow, "Y"), Cells(Erow, "Y")).Select 'P1 pressure
    Selection.Copy
   
    Windows("PumpSheetCalculator.xls").Activate
    Worksheets("TotFinFlow").Select
    Range("AH42").Select
   
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        'Range("A1").Select
   
    ''''''
       
    Windows("ebtrends.csv").Activate
    ActiveWindow.WindowState = xlMaximized
   ActiveWorkbook.Close savechanges = False
  
   
       
200 Sheets("Sheet1").Select
    Range("A4").Select
  
999 End Sub

 

[Anthony47]

I am afraid that dates in your Sheets("Sheet1").Cells(5, "C") and in ebtrends col A have different formats

Try replacing your whole For I = 2 To 10000 /Next I loop with these lines:

bRow = Evaluate("MIN(IF(INT(EBTrends!A1:A10000)=" & CLng(MDate) & ",ROW(A1:A10000),""""))")
eRow = Evaluate("MAX(IF(INT(EBTrends!A1:A10000)=" & CLng(MDate) & ",ROW(A1:A10000),""""))")
Debug.Print "Date=" & Format(MDate, "dd-mmm-yyyy")
Debug.Print "BRow=" & bRow & vbCrLf & "ERow=" & eRow
Stop

Then start your macro; when it stops on the Stop line open the vba "Immediate Window" (typing Contr-g should do the job, or Menu /View /Immediate Window); it should say something like

Date=21-gen-2023
BRow=6
ERow=340

Check that the date is the one you are inspecting, and that BRow and ERow are consistent wiyh your list of dates

If the information is ok then make sure that sheet EBTrend is selected and continue executing the macro by hitting F5.

If the information is wrong then maybe tell us which are the discrepancies and we'll see

If the results are ok and the macro returns the correct information then we can greatly simplify your code and make it running faster

 

[westwegoman]

After replacing with that code, I got a runtime error '13' Type Mismatch on the following line.

Debug.Print "BRow=" & bRow & vbCrLf & "ERow=" & eRow

MDate was returning the correct date but brow and erow are returning "Error 2015"

 

[Anthony47]

That should mean the content of EBTrends column A is not a Date.

Format the column as Number with two decimal digits; if the cells show a number then they are dates, whereas if they remain "dates & hours" they are Strings
Could you share some real EBTFTrends datas, either using the XL2BB of by sharing a file?

 

[westwegoman]

I am unable to get XL2BB to work. Possibly cause I'm on a work computer.

Column A in ebtrends.csv does change to a number when formatted as a number. (currently formatted as m/d/yyyy h:mm)
The only cell in that column that is not a date is "A1". I assume that's why they start searching in row 2.

I'm baffled how it worked for this long and then just stopped.

As you thought earlier, dates in Pump Sheet Sheets("Sheet1").Cells(5, "C") and in ebtrends.csv col A have different formats. In the original workbook, it's just a date but has been working until recently.

If you would like a copy of the ebtrends file, I can send it to you somehow or upload it to my website for you to see.

 

[Anthony47]

So "2/1/2023 00:00" in ebtrends.csv means Jan-2nd or Feb-1st?
Could you specify how one cell reads as a date and which number is displayed when formatted as number?

How my code (the one that uses Evaluate) performs after having formatted column A as numbers (and the column displays numbers, not dates)?

 

[westwegoman]

"2/1/23 00:00" is Feb. 1st. When I change the format to a number, it reads 44958.00.

I'm not sure if you want me to change the format for all cells in column A or what. I can't really have it written that way as our SCADA system generates the EBTrends file and its preset with that format.

After running your code, the only thing that is returned when typing Ctrl + g is

Date=23-Feb-2023

Nothing about BRow or ERow

 

[Anthony47]

Let's see if it is a rounding problem: let's return to your original code but with a small change:

For i = 2 To 10000

    If Abs(Sheets("ebtrends").Cells(i, "A") - MDate) < 0.0001 And StartFlag = 0 Then                   'MMMM
        Sheets("ebtrends").Cells(i, "A").Select
        Brow = ActiveCell.Row
        StartFlag = 1
    End If

    If Sheets("ebtrends").Cells(i, "A") = "" Or Abs(Sheets("ebtrends").Cells(i, "A") - MDate) < 0.0001 And StartFlag = 1 Then         'MMMM
        Sheets("ebtrends").Cells(i, "A").Select
        Erow = ActiveCell.Row - 1
        GoTo 5
    End If
              
Next i

Lines marked MMM are modified, and they test not for beeing equals but having a difference in the range of seconds

Then run the macro ad let us know what happens

 

[Anthony47]

PS: we will make some "small changes" when the code works

 

[westwegoman]

Seems to be same as before. It's copying every row in the EBTrends file.