Finding date in range of cells

W

westwegoman

New Member
Joined
Aug 9, 2010
Messages
16
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
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.

VBA Code: 
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
 

Attachments

  • Screenshot 2023-02-23 081541.png
    Screenshot 2023-02-23 081541.png
    21.4 KB · Views: 5

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Sort by date Sort by votes
Ok, I downloaded your csv file
My opinion is that a csv file is a text file; any conversion should be done explicitally by the macro rather than rely on what excel do when it open the csv.
So I suggest that we do not OPEN the csv but IMPORT its content in a new worksheet and in this process we specify that column 1 is a Date in MDY format.
Also, as I said, your code can be rewritten to make it more efficient and more readable.

After these premises, this is my proposal:
1) Add in a new vba Module the following subroutine:
Code: 
Sub ImportEBT(ByVal FFName)
'
On Error Resume Next
Application.DisplayAlerts = False
    Sheets("EBTrendsZZ").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "EBTrendsZZ"
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & FFName, Destination:=Range("$A$1"))
        .Name = "ebtrends"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = " "
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub
We will "call" this ImportEBT to have the csv file imported into a newly created sheet that will be named EBTrendsZZ (this is the active sheet when the Sub completes; any existing EBTrendsZZ sheet will be deleted before creating a new one)



2) Going to your macro, I seem that you have two imports, from two different csv

A) In relation to the first csv, REMOVE the whole following block
Code: 
    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


B) Replace it with this block:
Code: 
'New code:
FMonth = Format(DateSerial(111, MonthNum, 1), "mmm")
Debug.Print "FMonth=" & FMonth
P3PlantFile = Drive1 + Folder + SYear + "\" + FMonth + "\ebtrends.csv"
Debug.Print "P3PlantFile=" & P3PlantFile
Call ImportEBT(P3PlantFile)
'
Brow = Evaluate("MIN(IF(INT(A2:A10000)=" & CLng(MDate) & ",ROW(A2:A10000),""""))")
Erow = Evaluate("MAX(IF(INT(A2:A10000)=" & CLng(MDate) & ",ROW(A2:A10000),""""))")
Debug.Print "Date=" & Format(MDate, "dd-mmm-yyyy")
Debug.Print "BRow=" & Brow & vbCrLf & "ERow=" & Erow
'Copy time:
Range(Cells(Brow, "C"), Cells(Erow, "C")).Copy _
   Destination:=Workbooks("PumpSheetCalculator.xls").Worksheets("TotFinFlow").Range("AC42")
Debug.Print "Copied " & Range(Cells(Brow, "C"), Cells(Erow, "C")).Address(0, 0)
'Copy P3 Pressure:
Range(Cells(Brow, "D"), Cells(Erow, "D")).Copy _
   Destination:=Workbooks("PumpSheetCalculator.xls").Worksheets("TotFinFlow").Range("AI42")
Debug.Print "P3-Copied " & Range(Cells(Brow, "D"), Cells(Erow, "D")).Address(0, 0)
'
'Remove the added worksheet:
On Error Resume Next
Application.DisplayAlerts = False
    Sheets("EBTrendsZZ").Delete
Application.DisplayAlerts = True
On Error GoTo 0


C) Similarly, REMOVE this block related to the second csv:
Code: 
    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

D) Replace it with this block
Code: 
'New code2:
'FMonth = Format(DateSerial(111, MonthNum, 1), "mmm")
'Debug.Print "FMonth=" & FMonth
FPPlantFile = Drive2 + Folder + SYear + "\" + FMonth + "\ebtrends.csv"
Debug.Print "FPPlantFile=" & FPPlantFile
Call ImportEBT(FPPlantFile)
'
Brow = Evaluate("MIN(IF(INT(A2:A10000)=" & CLng(MDate) & ",ROW(A2:A10000),""""))")
Erow = Evaluate("MAX(IF(INT(A2:A10000)=" & CLng(MDate) & ",ROW(A2:A10000),""""))")
Debug.Print "Date2=" & Format(MDate, "dd-mmm-yyyy")
Debug.Print "Brow2=" & Brow & vbCrLf & "Erow2=" & Erow
'Copy ???:
Range(Cells(Brow, "W"), Cells(Erow, "X")).Copy _
   Destination:=Workbooks("PumpSheetCalculator.xls").Worksheets("TotFinFlow").Range("AE42")
Debug.Print "Copied " & Range(Cells(Brow, "W"), Cells(Erow, "X")).Address(0, 0)
'Copy P1 Pressure:
Range(Cells(Brow, "Y"), Cells(Erow, "Y")).Copy _
   Destination:=Workbooks("PumpSheetCalculator.xls").Worksheets("TotFinFlow").Range("AI42")
Debug.Print "P1-Copied " & Range(Cells(Brow, "D"), Cells(Erow, "D")).Address(0, 0)
'
'Remove the added worksheet:
On Error Resume Next
Application.DisplayAlerts = False
    Sheets("EBTrendsZZ").Delete
Application.DisplayAlerts = True
On Error GoTo 0


In other words, the revised import macro should be:
Code: 
Sub GetFlowData222()
'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
  
'New code:
FMonth = Format(DateSerial(111, MonthNum, 1), "mmm")
Debug.Print "FMonth=" & FMonth
P3PlantFile = Drive1 + Folder + SYear + "\" + FMonth + "\ebtrends.csv"
Debug.Print "P3PlantFile=" & P3PlantFile
'Import the csv file:
Call ImportEBT(P3PlantFile)
'
'Calculate BRow & ERow:
Brow = Evaluate("MIN(IF(INT(A2:A10000)=" & CLng(MDate) & ",ROW(A2:A10000),""""))")
Erow = Evaluate("MAX(IF(INT(A2:A10000)=" & CLng(MDate) & ",ROW(A2:A10000),""""))")
Debug.Print "Date=" & Format(MDate, "dd-mmm-yyyy")
Debug.Print "BRow=" & Brow & vbCrLf & "ERow=" & Erow
'
'Copy time:
Range(Cells(Brow, "C"), Cells(Erow, "C")).Copy _
   Destination:=Workbooks("PumpSheetCalculator.xls").Worksheets("TotFinFlow").Range("AC42")
Debug.Print "Copied " & Range(Cells(Brow, "C"), Cells(Erow, "C")).Address(0, 0)
'
'Copy P3 Pressure:
Range(Cells(Brow, "D"), Cells(Erow, "D")).Copy _
   Destination:=Workbooks("PumpSheetCalculator.xls").Worksheets("TotFinFlow").Range("AI42")
Debug.Print "P3-Copied " & Range(Cells(Brow, "D"), Cells(Erow, "D")).Address(0, 0)
'
'Remove the added worksheet:
On Error Resume Next
Application.DisplayAlerts = False
    Sheets("EBTrendsZZ").Delete
Application.DisplayAlerts = True
On Error GoTo 0
  
  
'New code2:
'FMonth = Format(DateSerial(111, MonthNum, 1), "mmm")    'It has not changed from phase 1
'Debug.Print "FMonth=" & FMonth
FPPlantFile = Drive2 + Folder + SYear + "\" + FMonth + "\ebtrends.csv"
Debug.Print "FPPlantFile=" & FPPlantFile
Call ImportEBT(FPPlantFile)
'
Brow = Evaluate("MIN(IF(INT(A2:A10000)=" & CLng(MDate) & ",ROW(A2:A10000),""""))")
Erow = Evaluate("MAX(IF(INT(A2:A10000)=" & CLng(MDate) & ",ROW(A2:A10000),""""))")
Debug.Print "Date2=" & Format(MDate, "dd-mmm-yyyy")
Debug.Print "Brow2=" & Brow & vbCrLf & "Erow2=" & Erow
'Copy ???:
Range(Cells(Brow, "W"), Cells(Erow, "X")).Copy _
   Destination:=Workbooks("PumpSheetCalculator.xls").Worksheets("TotFinFlow").Range("AE42")
Debug.Print "Copied " & Range(Cells(Brow, "W"), Cells(Erow, "X")).Address(0, 0)
'Copy P1 Pressure:
Range(Cells(Brow, "Y"), Cells(Erow, "Y")).Copy _
   Destination:=Workbooks("PumpSheetCalculator.xls").Worksheets("TotFinFlow").Range("AI42")
Debug.Print "P1-Copied " & Range(Cells(Brow, "D"), Cells(Erow, "D")).Address(0, 0)
'
'Remove the added worksheet:
On Error Resume Next
Application.DisplayAlerts = False
    Sheets("EBTrendsZZ").Delete
Application.DisplayAlerts = True
On Error GoTo 0
  
 
200 Sheets("Sheet1").Select
    Range("A4").Select
 
999 End Sub
Try...
 
Upvote 1
Solution
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:
VBA Code: 
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
VBA Code: 
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
 
Upvote 0
After replacing with that code, I got a runtime error '13' Type Mismatch on the following line.

VBA Code: 
Debug.Print "BRow=" & bRow & vbCrLf & "ERow=" & eRow

MDate was returning the correct date but brow and erow are returning "Error 2015"
 
Upvote 0
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?
 
Upvote 0
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.
 
Upvote 0
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)?
 
Upvote 0
"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
VBA Code: 
Date=23-Feb-2023

Nothing about BRow or ERow
 
Upvote 0
Let's see if it is a rounding problem: let's return to your original code but with a small change:
VBA Code: 
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
 
Upvote 0
PS: we will make some "small changes" when the code works
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Subscript out of range error 9 on windows activate
2 3
Replies
20
Views
787
MARK858
MARK858
willow1985
  • Solved
Find first blank cell in column A in a Table - Runtime error 91
Replies
4
Views
138
willow1985
willow1985
P
  • Question
Excel VBA copying cell into another worksheet but using vlookup to find correct row based on date
Replies
1
Views
570
Fluff
Fluff
The Ruff Report
  • Solved
VBA - replace a character in a range to save
Replies
5
Views
210
RobP
R
S
  • Solved
VBA does not continue to copy after blank cell
Replies
8
Views
545
jolivanes
jolivanes

Forum statistics

Threads
1,215,632
Messages
6,125,909
Members
449,274
Latest member
mrcsbenson

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top