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

 

[westwegoman]

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

 

[Anthony47]

Can you share a csv file?

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

Can you explain which is the difference between the two formats?

 

[westwegoman]

Pump Sheet cell C5 has no formatting and only contains a date.

Column A in EBTrends contains a date and time and is formatted m/d/yyyy h:mm

I'm unable to attached the file here but you can get it at the following link.

EBTrends.csv

EBTrends.csv

www.westwegoman.com

 

[westwegoman]

Thank you so much! That worked like a charm.

I did kind of overlook the part where we were still opening two different EBTrend files. These used to be stored on two different servers. Since our SCADA upgrade, everything is now on one server. So, I went ahead and combined them. Seems to be working perfect now and is much faster.

 

[Anthony47]

Thank you for the feedback
May I suggest you check if the clearing done after the line 9 Worksheets("TotFinFlow").Select are correct?

 

[westwegoman]

Thank you for the feedback
May I suggest you check if the clearing done after the line 9 Worksheets("TotFinFlow").Select are correct?

Yes, they are. Thanks again for the help.