Hi guys,
The following code works but sometimes fails on the ".Refresh" step, I am wondering if there is any way I can fix this and prevent it from failing. Any ideas?
Sub Grader()
Call ImportCSVFile
Call YesterdayTo_Today
Call CopyToCsv
End Sub
Sub ImportCSVFile()
Dim Ws As Worksheet
Dim FileName As String
Set Ws = ActiveWorkbook.Sheets("Sheet1") ' change to suit
'Sheets("Sheet1").ClearContents
'Sheets("Sheet1").Clear
'Sheets("Sheet1").Cells.QueryTable.Delete
'Sheets("Sheet1").Cells.ClearContents
With Sheets("Sheet1")
.Range("A1", Sheets("Sheet1").Range("A2").SpecialCells(xlLastCell)).Clear
End With
FileName = "\\rapidproto_datashare\rapidproto_datashare\data\B4\shift_speeds\B4_grader_speeds_7days.csv"
' FileName = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please select source file")
With Ws.QueryTables.Add(Connection:="TEXT;" & FileName, _
Destination:=Ws.Range("A1")) ' change to suit
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh
End With
End Sub
Sub YesterdayTo_Today()
Dim dDate As Date
Dim strDate As String
Dim lDate As Double
dDate = Date - 1 + 0.25
lDate = dDate
'Range("A2", ActiveCell.SpecialCells(xlLastCell)).AutoFilter Field:=5, Criteria1:=">=" & Date - 1 + 0.25, Operator:=xlAnd
Range(Sheets("Sheet1").Range("A2"), Sheets("Sheet1").Range("A2").SpecialCells(xlLastCell)).AutoFilter Field:=5, Criteria1:=">=" & lDate, Operator:=xlAnd
End Sub
'Option Explicit
Sub CopyToCsv()
'sPath = Environ("USERPROFILE")
Set objNetwork = CreateObject("Wscript.Network")
CurrentUser = objNetwork.UserName
' Const TARGET_FOLDER = "C:\Temp\" 'Folder you save your CSV files in
' Const TARGET_FOLDER = Environ$("USERPROFILE") & "\Desktop\" 'Folder you save your CSV files in
TARGET_FOLDER = "C:\Users\" & CurrentUser & "\Desktop\" 'Folder you save your CSV files in
Const MYFILENAME = "GradeData"
Dim DataSheet As Worksheet
Dim CsvWorkbook As Workbook
Dim CsvSheet As Worksheet
Set DataSheet = ActiveSheet 'Replace with relevant sheet
DataSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy
Set CsvWorkbook = Workbooks.Add
CsvWorkbook.Sheets(1).Paste
Application.DisplayAlerts = False
CsvWorkbook.SaveAs FileName:=TARGET_FOLDER & MYFILENAME & ".csv", FileFormat:=xlCSV, local:=True
CsvWorkbook.Close
Application.DisplayAlerts = True
End Sub
Sub show()
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
End Sub
Bookmarks