You could do something like this...
Public Sub SaveCSV_AsXls()
Dim acpc As String, acpx As String, fac As String, xlsDir As String
Dim Well_Name_Short As String, Well_Name_Long As String
Select Case ActiveWorkbook.FileFormat
Case Is <> 6, 22, 23, 24
'MsgBox "Not a CSV"
Exit Sub
End Select
'disable viewing
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'csv path and name
acpc = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
'well name
On Error Resume Next
fac = ActiveSheet.Cells.Find(what:="Facility", after:=Range(Cells(1, 1).Address), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Address
If fac <> "" Then
Well_Name_Short = ActiveSheet.Cells(Range(fac).Row, Range(fac).Column + 1).Value
Else
Well_Name_Short = "Not Found"
End If
Well_Name_Long = "Survey Data_" & Well_Name_Short & ".xls"
'save as xls
ActiveWorkbook.SaveAs FileFormat:=xlExcel8
'path and name of new book
acpx = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
'close it
ActiveWorkbook.Close SaveChanges:=False
'set dir
xlsDir = Environ("USERPROFILE") & "\Desktop\Morning Reports\"
'if Morning Reports does not exist create it
If Len(Dir(xlsDir, vbDirectory)) = 0 Then
MkDir Environ("USERPROFILE") & "\Desktop\Morning Reports\"
End If
'delete csv and any older morning report
Kill acpc
Kill xlsDir & Well_Name_Long
'move file from temp folder to Morning Report
Name acpx As xlsDir & Well_Name_Long
'enable viewing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
OCD, it’s not obsessive if you can control it…