VBA code to delete and replace this month's data

[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.

[RPFeynman06]

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.


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?

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

[Danawood]

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...

[Bob Phillips]

Try replacing your filter with a date filter


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

with


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

[Danawood]

Try replacing your filter with a date filter


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

with


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.

[Bob Phillips]

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.


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

[Bob Phillips]

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


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

[Danawood]

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?

'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.

[bekean23]

Thanks, it work!

[Aussiebear]

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.