Excel VBA Code Save and Close - vba

I want to loop through 2000 csv files, convert them to xls, make changes to the spreadsheet.
I can't work out how to save and close the workbook before moving on to the next.
I tried the following at the end of the script.
Application.ActiveWindow.Close SaveChanges:=False
ActiveWorkbook.Close SaveChanges:=False
I get a Minor loss of fidelity message.
The full code
Sub batchconvertcsvxls()
Dim wb As Workbook
Dim strFile As String, strDir As String, strOut_Dir As String, myNewFileName As String
strDir = "C:\csv\" 'location of csv files
strOut_Dir = "C:\converted\" 'location of xls files
strFile = Dir(strDir & "*.csv")
Do While strFile <> ""
Set wb = Workbooks.Open(filename:=strDir & strFile, Local:=True)
With wb
.SaveAs strOut_Dir & Replace(wb.Name, ".csv", ".xls"), 56
.Close True
End With
Set wb = Nothing
Set wb = Workbooks.Open(filename:=strOut_Dir & Replace(strFile, ".csv", ".xls"))
Rows("1:1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark2
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Selection.RowHeight = 60
Selection.ColumnWidth = 30
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("E:E").Select
With Selection
.HorizontalAlignment = xlLeft
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells.Select
Selection.AutoFilter
Range("E2").Select
ActiveWindow.FreezePanes = True
For i = 1 To ActiveSheet.UsedRange.Columns.Count
DataFound = False
j = 2
While DataFound = False And j <= ActiveSheet.UsedRange.Rows.Count
If Cells(j, i).Value <> "" Then
DataFound = True
End If
j = j + 1
Wend
If DataFound = False Then
Columns(i).Hidden = True
End If
Next
strFile = Dir
Application.ActiveWindow.Close SaveChanges:=True ActiveWorkbook.Close
SaveChanges:=False
Loop
End Sub

You can try wb.Close SaveChanges:=False since you have set the workbook as wb that may get it to close without the message box popping up.
Also you can try Application.DisplayAlerts = False(this goes at the start of your code), it stops most types of messages popping up (there are some errors that cannot be stopped though(I dont have a list to hand but "out of memory" is an error that cannot be prevented for instance)).
I'll look into it a bit more sine im doing this off the top of my head and update the post if I get any more

Related

Run time Error 91 when using excel object in access

I have a problem. I am trying to get records from the data base to Excel and afterwards format the Excel file. If I implement the whole function then it will run fine on one occasion. But if I run it again it sometimes gives the runtime 91 error. I was going through the debugging and if I only have the first ApXl in the function the code will work fine with no issues. However, if I add more of the code to reformat the Excel sheet then it will eventually give me the run time 91 even though the variables are already declared. Below is part of my code with some of the formatting.
Public Function ExportToExcelEM(Numbcases, strObjectType As String, strObjectName As String, Optional strSheetName As String, Optional strFileName As String)
Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim intCount As Integer
Const xlToRight As Long = -4161
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107
Const xlContinuous As Long = 1
Dim OBJ As Object
On Error GoTo ExportToExcel_Err
DoCmd.Hourglass True
Select Case strObjectType
Case "Table", "Query"
Set rst = CurrentDb.OpenRecordset(strObjectName, dbOpenDynaset, dbSeeChanges)
Case "Form"
Set rst = Forms(strObjectName).RecordsetClone
Case "Report"
Set rst = CurrentDb.OpenRecordset(Reports(strObjectName).RecordSource, dbOpenDynaset, dbSeeChanges)
End Select
If rst.RecordCount = 0 Then
MsgBox "No records to be exported.", vbInformation, GetDBTitle
DoCmd.Hourglass False
Else
On Error Resume Next
Set ApXL = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set ApXL = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo ExportToExcel_Err
Set xlWBk = ApXL.Workbooks.Add
ApXL.Visible = False
Set xlWSh = xlWBk.Worksheets("Sheet1")
If Len(strSheetName) > 0 Then
xlWSh.Name = Left(strSheetName, 31)
End If
xlWSh.Range("A1").Select
Do Until intCount = rst.Fields.Count
ApXL.ActiveCell = rst.Fields(intCount).Name
ApXL.ActiveCell.Offset(0, 1).Select
intCount = intCount + 1
Loop
rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
** ** ** With ApXL
.Range("A1").Select
.Range(.Selection, .Selection.End(xlToRight)).Select
.Selection.Interior.Pattern = xlSolid
.Selection.Interior.PatternColorIndex = xlAutomatic
.Selection.Interior.TintAndShade = -0.25
.Selection.Interior.PatternTintAndShade = 0
.Selection.Borders.LineStyle = xlNone
.Selection.AutoFilter
.Cells.EntireColumn.AutoFit
.Cells.EntireRow.AutoFit
.Range("B2").Select
.ActiveWindow.FreezePanes = True
.ActiveSheet.Cells.Select
.ActiveSheet.Cells.WrapText = False
.ActiveSheet.Cells.EntireColumn.AutoFit
.Visible = False
End With********
With ApXL
xlWSh.Rows(1).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End With
xlWBk.SaveAs FileName:=strFileName, FileFormat:=51
xlWBk.Close
Set xlWBk = Nothing
Set xlWSh = Nothing
Set ApXL = Nothing
' end of doing anything with excel
End If
rst.Close
Set rst = Nothing
DoCmd.Hourglass False
ExportToExcel_Exit:
DoCmd.Hourglass False
Exit Function
ExportToExcel_Err:
DoCmd.SetWarnings True
Set xlWBk = Nothing
Set xlWSh = Nothing
Set ApXL = Nothing
rst.Close
MsgBox Err.Description, vbExclamation, Err.Number
DoCmd.Hourglass False
Resume ExportToExcel_Exit
End Function
debugging: works once after adding more formatting in my code but then gives me a runtime 91 error. I added more code chunks to the code till it was the complete excel function I desired. Throughout the process it would give me the finish piece I wanted but afterwards gives me a runtime error 91.
After running procedure, check if instance of Excel is still showing in Task Manager. This can be result of using Active______ referencing. Use explicit reference instead.
When I compile your procedure, I get "Method or data member not found." error on each line in the xlWSh.Rows(1).Select block. Use With .Rows(1) instead.
Could probably perform this process without actually selecting anything. Use explicit Cells or Range reference: With .Range("A1:E1") - construct reference with variables.
Modified your code to apply and it works:
intCount = rst.Fields.Count
Set xlWSh = xlWBk.worksheets("Sheet1")
With xlWSh
If strSheetName <> "" Then .Name = Left(strSheetName, 31)
For x = 1 To intCount
.Cells(1, x).Value = rst(x - 1).Name
Next
.Range("A2").CopyFromRecordset rst
With .Range(.Cells(1, 1), .Cells(1, intCount))
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
.Interior.TintAndShade = -0.25
.Interior.PatternTintAndShade = 0
.Borders.LineStyle = xlNone
.AutoFilter
.EntireColumn.AutoFit
End With
With .Rows(1)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.shrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Rows.AutoFit
End With
ApXL.Windows(1).SplitColumn = 1
ApXL.Windows(1).SplitRow = 1
ApXL.Windows(1).FreezePanes = True

Importing multiple CSV files into multiple worksheets in Excel using VBA

I am working to create a VBA/macro that imports 2 CSV files from a specific folder into 2 worksheets in an Excel template that I have created.
To be more specific, these files are created and saved as new workbooks on a daily basis (two new files being added into the folder everyday) so my problem is how to code my macro to always import the 2 latest files?
Please see below the code from which I manually select and import the latest files using macro. However, re-running the macro does not work as it shows "run-time error '5' - invalid procedure call or argument". Your help would be much appreciated.
Sub Macro1()
'
' Macro1 Macro
' IMPORT CSV FILES
'
'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;P:\APS\Reports_From_PDP\AP_PDP_VehicleLoad_Report_AM 19-01-2018 3-15-03 AM.csv" _
, Destination:=Range("$A$1"))
.CommandType = 0
.Name = "AP_PDP_VehicleLoad_Report_AM 19-01-2018 3-15-03 AM"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets.Add After:=ActiveSheet
Application.CutCopyMode = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;P:\APS\Reports_From_PDP\AP_PDP_VehicleLoad_Report_PM 19-01-2018 7-15-02 PM.csv" _
, Destination:=Range("$A$1"))
.CommandType = 0
.Name = "AP_PDP_VehicleLoad_Report_PM 19-01-2018 7-15-02 PM"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("Sheet1").Select
Columns("A:N").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
Sheets("Sheet2").Select
Columns("A:N").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "PM"
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "AM"
Sheets("AM").Select
End Sub
You can find the latest file(s) this way:
EDIT: Dir return only the filename, so you need to append the path, too.
EDIT2: As per user request a few Debug.Print is inserted.
Sub main()
Dim s1 as String, s2 as String
s1 = LastFile("P:\APS\Reports_From_PDP\AP_PDP_VehicleLoad_Report_AM")
Debug.Print "Last file1: " & s1
s2 = LastFile("P:\APS\Reports_From_PDP\AP_PDP_VehicleLoad_Report_PM")
Debug.Print "Last file2: " & s2
End Sub
Function LastFile(sName as String) as String
Dim dLatest as Date
Dim dFound as Date ' date of one matching filename
Dim sLatest as string ' the latest file or ""
Dim sFound as string ' one matching filename
Dim sPath as string
dLatest = 0
sLatest = vbnullstring
sPath = Left$(sName, InStrRev(sName, "\"))
sFound = Dir(sName & "*.csv")
Do While sFound <> vbnullstring
Debug.Print "Found: " & sFound
dFound = FileDateTime(sPath & sFound)
If dFound > dLatest Then
dLatest = dFound
sLatest = sFound
Endif
sFound = Dir
Loop
LastFile = sLatest
End Function

Determine once on the last page to stop macro

I am scraping data from a webpage. Once on the last page, how do I get the macro to end?
For instance, if there are 4 pages of data, how do I stop and display the data scrape through the 4 pages?
There are 4 pages of data. I receive the 1004 run time error, if in the code I say
Do While i < 5
...
'Macro to query Delinquency Status Search for DFB Counties
'Run Monday to pull data from Friday
Sub queryActivityDailyMforF()
Dim nextrow As Integer, i As Long
Dim dates
dates = Date - 3
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Do While i < 4
Application.StatusBar = "Processing Page " & i
nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://www.myfloridalicense.com/delinquency_results.asp?SID=&page=" & i & "&county_1=16&county_1=21&county_1=23&county_1=32&county_1=36&county_1=41&county_1=46&county_1=53&county_1=54&county_1=57&county_1=60&county_1=66&status=NS&send_date=" & dates & "&search_1.x=1", _
Destination:=Range("A" & nextrow))
'.Name = _
"2015&search_1.x=40&search_1.y=11&date=on&county_1=AL&lic_num_del=&lic_num_rep=&status=NS&biz_name=&owner_name="
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "10"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
'autofit columns
Columns("A:G").Select
Selection.EntireColumn.AutoFit
'check for filter, if not then turn on filter
ActiveSheet.AutoFilterMode = False
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("D2").AutoFilter
End If
i = i + 1
End With
Loop
Application.StatusBar = False
'Align text left
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
If i = 0 Then Exit Sub
'Loop
End Sub
I'm sure there is a better answer involving querying the table or getting an xml version of the results from the webmaster of the site, and THIS IS NOT BEST PRACTICE but you could use the error handler. It should look like this, generically:
Sub Stuff()
Do While True
On Error Goto ErrHndl
ErrorProneCode
Loop
LoopExit:
On Error Resume 0
Non_ErrorProneCode
Exit Sub
ErrHndl:
If Err.Number = 1004 Then
Resume LoopExit
Else
Err.Raise Err.Number, Err.Description, Err.Source
End If
End Sub
In the sample above, if an error is throne by the ErrorProneCode sub, the script will jump to the ErrHndl: label. There we check for the 1004 error and if that's the error we find, we resume at the LoopExit: label, and continue on. It is advised that you disable your error handler by calling On Error Resume 0 once you are executing code which you do not expect to break.

Merging and Centering Cells in VBA

I recently set out to write a simple macro the merge/unmerge cells with a keyboard shortcut.
The macro is working currently with the following code:
If Selection.MergeCells = True Then
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.UnMerge
ElseIf Selection.MergeCells = False Then
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
End If
This works perfectly well, but I originally had a much simpler sub that didn't work. It was:
If Selection.MergeCells = False Then Selection.Merge
If Selection.MergeCells = True Then Selection.UnMerge
This two-line version only worked to merge cells, not to unmerge them. Does anyone know why this was happening?
Thanks.
-Sean
You need an ELSE
Sub qwerty()
If Selection.MergeCells = False Then
Selection.Merge
Else
Selection.UnMerge
End If
End Sub

Prompt for file in Excel Macro when getting external data from text

We're using an AutoCad utility, CleanupScale 2014, that we want to encourage users to run before using CAD files provided by others in production. The CSV log file generated by this utility is easiest viewed when imported into Excel by getting external data from text then formatting it. We'd like to automate as much of this process via a VBA script.
Part of the problem is that the file to import doesn't always have the same file or sheet name.
Can anyone help us with editing the below VBA script so that it will prompt for the CSV file to get the text from before continuing on with the formatting & filtering?
Sub ScaleListCleanupLog()
' ScaleListCleanupLog Macro
' Format the Scale List Cleanup Log for easier viewing.
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\User\Documents\CleanupScales48.csv", Destination:=Range( _
"$A$1"))
.Name = "CleanupScales48"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Rows("1:1").Select
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("B:E").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("E1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$E$24").AutoFilter Field:=5, Criteria1:= _
"=Error saving drawing", Operator:=xlOr
End Sub
If I understand right (And I may be completely off) the main problem is returning the path of the CSV that the user selects?
Dim myObj As Object
Set myObj = Application.FileDialog(msoFileDialogOpen)
myObj.Show
Dim myDirString As String
myDirString = myObj.SelectedItems(1)
MsgBox myDirString
The messagebox is just for testing - after this point, the user has selected the file, and you can use myDirString to replace that file path. Apologies if this isnt what you're looking for
Edit1: To answer OP's comment on where to put the code. Added routine to anticipate Cancel as well. Also I used msoFileDialogFilePicker instead of msoFileDialogOpen so I can set the CSV File Filter.
Edit2: Team effort - try this, and see if it runs without errors? It's the exact same as your original code, but we added the File Dialog browswer which lets a user select a file, then we replaced that hardcoded directory you had with the file directory returned from the File Dialog browser. This should (might) work without error
Edit3:
Just because this is helping me learn a few things too, added one line - " .InitialFileName = "C:\Users\" & Environ$("Username") & ".domain\Documents"" which should change the default directory
Sub ScaleListCleanupLog()
' ScaleListCleanupLog Macro
' Format the Scale List Cleanup Log for easier viewing.
Dim myObj As Object
Dim myDirString As String
Set myObj = Application.FileDialog(msoFileDialogFilePicker)
With myObj
.InitialFileName = "C:\Users\" & Environ$("Username") & ".domain\Documents"
.Filters.Add "Comma Delimited Files", "*.csv"
.FilterIndex = 1
If .Show = False Then MsgBox "Please select CSV file.", vbExclamation: Exit Sub
myDirString = .SelectedItems(1)
End With
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & myDirString, Destination:=Range("$A$1"))
.Name = "CleanupScales48"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'rest of the formatting codes here
Rows("1:1").Select
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("B:E").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("E1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$E$24").AutoFilter Field:=5, Criteria1:= _
"=Error saving drawing", Operator:=xlOr
End Sub
Try this:
Dim myfile
myfile = Application.GetOpenFileName("Comma Delimited Files, *.csv")
If myfile <> False Then
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & myfile, Destination:=Range("$A$1"))
'~~> rest of your code here
End With
Else
MsgBox "Please select CSV file.", vbExclamation: Exit Sub
End If
'~~>Then your formatting codes here
Hope this helps.