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
Sort by date Sort by votes
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
Click to expand...
Can you explain which is the difference between the two formats?
 
Upvote 0

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
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 www.westwegoman.com
 
Upvote 0
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
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.
 
Upvote 0
Thank you for the feedback
May I suggest you check if the clearing done after the line 9 Worksheets("TotFinFlow").Select are correct?
 
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
724
MARK858
MARK858
P
  • Question
Excel VBA copying cell into another worksheet but using vlookup to find correct row based on date
Replies
1
Views
561
Fluff
Fluff
The Ruff Report
  • Solved
VBA - replace a character in a range to save
Replies
5
Views
181
RobP
R
S
  • Solved
VBA does not continue to copy after blank cell
Replies
8
Views
526
jolivanes
jolivanes
N
  • Question
Select Method of Range Class Failed with Table
Replies
4
Views
195
NorthbyNorthwest
N

Forum statistics

Threads
1,215,066
Messages
6,122,948
Members
449,095
Latest member
nmaske

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