Run VBA without saving over template

[RomanVid]

Hi All,

I am currently running a macro that parses out a pipe delimited csv. It then cleans up some artifacts, and saves it with a variable name based on which report they pick from a list.

Currently, once the macro is done running, the macro file not only saves a copy of the report to a location on a shared drive, but then it becomes the actual report.

I would like the Macro to open a new excel file run the output onto it, save and close. Without the data overwriting the open Macro, so the use can go ahead and run it multiple times without reopening the program.

Thank you in advance for your responses.
Your Truly,
Newb of Newbs

 

[ranman256]

At the 1st step in the macro have it start a new workbook.
workbooks.Add

now everthing will go in the new book and stay out of the macro book.

 

[RomanVid]

Thanks for the response!

When running it with that included I get a 'subscript out of range' error.

 

[RomanVid]

This is what I have come up with after a little googling. Now my only issue is having the new workbook save properly



Sub ParsePipeRemoveQuotes()


Dim DateP As String
Dim DateS As String
Dim DateR As Date
Dim ReporN As String
Dim ReporO As String
Dim Wk As Workbook

Call AddNew(Wk)

DateR = ThisWorkbook.Worksheets("Macro").Range("$F$1")
'MsgBox DateR
DateP = Format(DateR, "mm") & " " & Format(DateR, "dd")
'MsgBox DateP
DateS = Format(DateR, "mmddyyyy")
' MsgBox DateS
ReporN = ThisWorkbook.Worksheets("Macro").Range("$A$1")
'MsgBox ReporN
ReporO = ThisWorkbook.Worksheets("Lists").Range("$D$1")
' MsgBox ReporO


With Worksheets("Sheet1").QueryTables.Add(Connection:= _
"TEXT;N:\Operations\Reports\MeritMountainside\Relay Assurance\" & ReporN & " " & DateP & ".csv" _
, Destination:=Wk.Sheets("Sheet1").Range("$A$1"))
.FieldNames = True
.RowNumbers = False
.AdjustColumnWidth = True
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierNone
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With


Call RemoveQuotes
Call RemoveArtifacts
Call SaveAsEPremis((ReporO), (DateS))

End Sub
Sub AddNew(Wk)
Set Wk = Workbooks.Add
With Wk
.Title = "tempParse"
End With
End Sub





Sub RemoveQuotes()
Worksheets("Sheet1").Activate
Cells.Select
Selection.Replace What:="""", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub


Sub RemoveArtifacts()


Worksheets("Sheet1").Activate
Columns("M:M").Select
Selection.Replace What:=",", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub




Sub SaveAsEPremis(ReporO, DateS)
Application.DisplayAlerts = False


ChDir "N:\Operations\Reports\MeritMountainside\Relay Assurance"
Wk.SaveAs Filename:= _
"N:\Operations\Reports\MeritMountainside\Relay Assurance\" & CStr(ReporO) & DateS & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub

 

[Norie]

Pass Wk to SaveAsEPremis.

 

[RomanVid]

Thank you! Works great now.