VBA code to delete and replace this month's data

Hello, and thank you in advance for help. I don't do a tremendous amount with VBA and my code isn't quite working.

Context:
Each morning I download an excel file from a third party program and place in a folder (data_bsi_Data). This file is grabbed by the macro in Apriso Build 2022 MASTER file-WC2. Power BI uses this file. We do not want to change this process. There are actually multiple data files that feed into the Master file but only one is used here.

Prior to me dickering with it the Apriso Build 2022 MASTER file would take the day's data and append it to the bottom of its records. But because departments change previous days' data what I want is to remove all of current month's data and replace with new current month's data. I do not want to delete previous month's data (January in this case).

Issue:
My code is appending Feb 01-14th data to end of records. It is not deleting the Feb 01-07
data that currently exists in file. Code is not throwing any errors. I feel it has to do with the code involving the definitions of date variables but I'm not sure.

I've attached dummy files.

Again, thank you. I'm chasing my tail at this point, lol.

Quote:

---

Originally Posted by Danawood

Hello, and thank you in advance for help. I don't do a tremendous amount with VBA and my code isn't quite working.

Context:
Each morning I download an excel file from a third party program and place in a folder (data_bsi_Data). This file is grabbed by the macro in Apriso Build 2022 MASTER file-WC2. Power BI uses this file. We do not want to change this process. There are actually multiple data files that feed into the Master file but only one is used here.

Prior to me dickering with it the Apriso Build 2022 MASTER file would take the day's data and append it to the bottom of its records. But because departments change previous days' data what I want is to remove all of current month's data and replace with new current month's data. I do not want to delete previous month's data (January in this case).

Issue:
My code is appending Feb 01-14th data to end of records. It is not deleting the Feb 01-07
data that currently exists in file. Code is not throwing any errors. I feel it has to do with the code involving the definitions of date variables but I'm not sure.

I've attached dummy files.

Again, thank you. I'm chasing my tail at this point, lol.

---

First and foremost you are not declaring variables in your code. This is a must so please use Option Explicit to ensure that the code will run smoothly.

Code:

---

Option Explicit

Dim envUser As String, user As String, TemplateName As String, FileToOpen As String
Dim SourceName As String, LastRow As String, SourceFileName As String, currMonth As Date, PrevMonth As Date
Dim currYear As Date, currDay As Date, FileDT As String

---

Next, I will review the code to determine why you are appending but not deleting the current months data. I will then provide my feedback on this. At first glance this portion of code is something I want to understand as it looks like you are resetting the current month to the previous month. My question is why?

Code:

---

If currDay = "01" Then
    currMonth = PrevMonth & "-" & currYear
    End If

---

Hi! Thank you for your help.
What actually happens is each morning (at around 0600) I'm pulling the data from yesterday. If its Feb 1 calendar wise the data is actually Jan 31st and should be replacing "previous month" data. But on Feb 2 the previous day is Feb 1st and "currMonth".

The dates and formatting of dates is the section I feel least confident about...

Try replacing your filter with a date filter

Code:

---

    ActiveSheet.Range("A1:G" & LastRow).AutoFilter Field:=5, Criteria1:=currMonth

---

with

Code:

---

    ActiveSheet.Range("A1:G" & LastRow).AutoFilter Field:=5, Criteria1:=xlFilterThisMonth, Operator:=xlFilterDynamic

---

Quote:

---

Originally Posted by Bob Phillips

Try replacing your filter with a date filter

Code:

---

    ActiveSheet.Range("A1:G" & LastRow).AutoFilter Field:=5, Criteria1:=currMonth

---

with

Code:

---

    ActiveSheet.Range("A1:G" & LastRow).AutoFilter Field:=5, Criteria1:=xlFilterThisMonth, Operator:=xlFilterDynamic

---

---

On the 1st day of month though it seems like it'd simply paste the data as the the new month (doubling the data essentially) rather than replacing the entire prior month? As example, on Feb 1st when I run data it is data covering Jan 1-Jan31st. This data needs to replace the existing Jan 1- Jan 30 data.

I've also had a go at re-formatting your code, declare variables, remove unnecessary selecting, and breaking it down into more manageable procedures. Not saying it is perfect, I would do it quite a bit differently, and not tested, but take a look and see if you can learn anything from it.

Code:

---

Option Explicit

Sub upload_BSI_Data()
    Dim importWb As Workbook
    Dim docsFolder As String
    Dim FileToOpen As String
    Dim SourceFileName As String
    Dim TemplateName As String
    Dim FileDT
    Dim Lastrow As Long
    Application.ScreenUpdating = False
    Application.Calculation = xlAutomatic   
    docsFolder = CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
    TemplateName = ActiveWorkbook.Name
    ' Get file name
    If Worksheets("home").Range("A1") = "Robot" Then
        FileToOpen = docsFolder & "\RobotFiles\US_Tasks\US\Daily_Opts_Metrics_Report\Downloaded\data_bsi_Data.xlsx"
    Else
        ' Open dialog box to select source
        MsgBox "Select the file"
        FileToOpen = Application.GetOpenFilename(Title:="Please choose a file to import")
        If Not FileToOpen Then
            MsgBox "No file specified.", vbExclamation, "Alert!!!"
            Application.ScreenUpdating = True
            Exit Sub
        End If
    End If   
    ' Upload process
    ' Clear contents in Original Report
    ClearFilters Worksheets("Input")
    Lastrow = GetLastRow(Worksheets("Input"))
    If Lastrow > 1 Then Worksheets("Input").Range("A2:G" & Lastrow).Clear   
    ' Open downloaded file
    Set importWb = Workbooks.Open(Filename:=FileToOpen)
    Application.Wait Now + #12:00:05 AM#
    SourceFileName = importWb.Name   
    ' Copy data from source file
    Lastrow = GetLastRow(ActiveSheet)
    ActiveSheet.Range("A2:G" & Lastrow).Copy   
    ' Paste data to Apriso Build master file Input tab
    Windows(TemplateName).Activate
    ActiveSheet.Range("A2").Paste   
    ' Format date in column E
    Lastrow = GetLastRow(ActiveSheet)
    With ActiveSheet   
        .Range("E2:E" & Lastrow).NumberFormat = "MM/dd/yyyy"   
        ' Change format of text on Input tab
        .Columns("C:C").TextToColumns Destination:=Range("C1") DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True               
        ' Auto fit and center all columns
        With .Columns("A:J")       
            .EntireColumn.AutoFit
            .HorizontalAlignment = xlCenter
        End With
    End With       
    ' Close source file
    Application.DisplayAlerts = False
    Windows(SourceFileName).Close
    Application.DisplayAlerts = True   
    RemoveCurrentMonth Worksheets("Apriso_Starts_Completes")   
    CopyToInput Worksheets("Input"), Worksheets("Apriso_Starts_Completes")   
    ' Get date from source file
    FileDT = FileDateTime(FileToOpen)               
    Application.ScreenUpdating = True
    ' Info for users
    Worksheets("home").Range("G9") = FileDT
    Worksheets("home").Range("G10") = FileToOpen     
    ' Reset
    Application.ScreenUpdating = True
    Worksheets("HOME").Range("A1").Select   
    ' Communication to user
    If Worksheets("home").Range("A1") <> "Robot" Then MsgBox "Step Completed"
End Sub

Private Function RemoveCurrentMonth(ByRef ws As Worksheet)
    ' The following removes the current months data from the template in order to update with the latest download
    Dim currYear As Long, prevMonth As Long, currMonth As Long, currDay As Long
    Dim Lastrow As Long
    ClearFilters ws   
    prevMonth = IIf(Month(Date) = 1, 12, Month(Date) - 1)
    currMonth = Month(Date)
    currYear = Year(Date)
    currDay = Day(Date)       
    If currDay = 1 Then currMonth = prevMonth & "-" & currYear       
    With ws   
        ' Filter columns to show current months data and removes to allow for update
        .Range("A1").AutoFilter   
        Lastrow = GetLastRow(ws)
        .Range("A1:G" & Lastrow).AutoFilter Field:=5, Criteria1:=xlFilterThisMonth, Operator:=xlFilterDynamic
        On Error Resume Next
            .Range("$A$1:$G$" & Lastrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        On Error GoTo 0
        ClearFilters ws
    End With
End Function

Public Function CopyToInput(ByRef ws As Worksheet, ByRef source As Worksheet)
    Dim inputLastrow As Long, sourceLastrow As Long
    ' Copy columns to Apriso tab from Input tab
    With source       
        inputLastrow = GetLastRow(ws)
        ws.Range("A2:AG" & inputLastrow).Copy       
        sourceLastrow = GetLastRow(source)
        .Range("A" & sourceLastrow + 1).PasteSpecial xlPasteAll   
        ' Auto fit and center all columns
        .Columns("A:G").EntireColumn.AutoFit
        .Columns("A:G").HorizontalAlignment = xlCenter
    End With   
    ' Clear contents in Original Report
    With ws   
        ClearFilters ws
        If inputLastrow > 1 Then .Range("A2:G" & inputLastrow).Clear
    End With
End Function

Private Function ClearFilters(ByRef ws As Worksheet)
    With ws
        If .AutoFilterMode = True Then .AutoFilterMode = False
    End With
End Function

Private Function GetLastRow(ByRef ws As Worksheet) As Long
    With ws
        GetLastRow = .Range("A1").Offset(.Rows.Count - 1, 0).End(xlUp).Row
    End With
End Function

---

Quote:

---

Originally Posted by Danawood

On the 1st day of month though it seems like it'd simply paste the data as the the new month (doubling the data essentially) rather than replacing the entire prior month? As example, on Feb 1st when I run data it is data covering Jan 1-Jan31st. This data needs to replace the existing Jan 1- Jan 30 data.

---

Just put a test in for 1st then

Code:

---

ActiveSheet.Range("A1:G" & LastRow).AutoFilter Field:=5, Criteria1:=iif(day(Date)=1,xlFilterLastMonth,xlFilterThisMonth), Operator:=xlFilterDynamic

---

Hi,

You are awesome. The new code I'm going to need to digest and look pieces of it up before I understand it...it does look cleaner than my chicken-scratch...but the filter is magnificent. I'm trying to add a second criteria for the first column but getting syntax errors for the second one. I've looked up the Microsoft help page and can't find something that fits...nor does my general online searches. The values in the column are BMK- followed by various numbers. I've tried quotes and no quotes around BMK*. Thoughts?

Code:

---

' Filters Date column that if day of month is "1" it removes this and last month's data.
    ActiveSheet.Range("A1:G" & LastRow).AutoFilter Field:=5, Criteria1:=IIf(Day(Date) = 1, xlFilterLastMonth, xlFilterThisMonth), Operator:=xlFilterDynamic
    ' Filters by BMK in first column
    ActiveSheet.Range("A1:G" & LastRow).AutoFilter Field:=1, Criteria2:=BMK*, Operator:=xlFilterValues

---

I appreciate the help...I'm self teaching and it's helpful for me to see how code executes in my files...and then I can understand the official documentation a bit better, too.

Thanks, it work!

bekean23, Welcome to VBAX. If you are going to post something to an old thread please make it more than just a throw away comment.