[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Excel VBScript:  Adapting Script to Merge CSVs

Posted on 2011-04-21
5
Medium Priority
?
827 Views
Last Modified: 2012-05-11
I have this great bit of VBScript that is picking up .xls files within a defined directory and running them through a cleanse process before a pivottable is applied.  I'd like to take this one step further and cleanse, then merge the files into one master spreadsheet before the pivottable and file save as a CVS.
'<~~ Folder where the 3 files are
Const MyPath = "C:\Temp\"
Const xlCSV = 6
Const xlUp = -4162
Const xltoLeft = -4131
Const xlDatabase = 1
Const xlPivotTableVersion10 = 1
Const xlRowField = 1
Const xlSum = -4157

Dim oXL, oFolder, aFile, FSO
Dim wb1, wb2, ws1, ws2
Dim LastRow, pvtDataSource,MyPivotCache

Set oXL = CreateObject("Excel.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = FSO.GetFolder(MyPath)

'~~> Loop through each folder to get the file name
For Each aFile In oFolder.Files
    '~~> Check if it is an excel file
    If Right(LCase(aFile.Name), 4) = ".xls" Then
        Set wb1 = oXL.Workbooks.Open(MyPath & aFile.Name)
        Set ws1 = wb1.Sheets("ABB")
        oXL.Visible = True
        With ws1
            '~~> Clean UP
			.Rows("1:5").Delete 
            .Range("A:C,E:E").Delete 
            LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
            
			'~~> Set the Pivot Table Data Source
            pvtDataSource = "ABB!R1C1:R" & LastRow & "C5"
            
			Set ws2 = wb1.WorkSheets.Add
            ws2.Name = "PvtTable"
			
			'~~> Add Pivot Table
            oXL.activeworkbook.PivotCaches.Add(xlDatabase, pvtDataSource).CreatePivotTable "'PvtTable'!R3C1", _
			"PivotTable1", xlPivotTableVersion10
        End With
        
		'~~> Set the Fields
        With ws2.PivotTables("PivotTable1").PivotFields("Acct Num")
            .Orientation = xlRowField
            .Position = 1
        End With
        
		ws2.PivotTables("PivotTable1").AddDataField oXL.ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("ABB"), "Sum of ABB", xlSum
        
        ws2.Copy

        Set wb2 = oXL.Workbooks(oXL.ActiveWorkbook.Name)
        
		'~~> Save As csv
		wb2.SaveAs MyPath & Replace(wb1.Name,".xls","") & ".csv", xlCSV
		
		oXL.DisplayAlerts = False
		wb1.Close False
		wb2.Close False
		oXL.DisplayAlerts = True
    End If
Next

Set wb1 = Nothing
Set ws1 = Nothing
Set wb2 = Nothing
Set ws2 = Nothing
Set oFolder = Nothing
oXL.Quit
Set oXL = Nothing

Open in new window

0
Comment
Question by:ITDeptAtPCS
  • 3
  • 2
5 Comments
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 2000 total points
ID: 35443390
Ok Try this. It will create a "Report.csv" in that folder.

Sid

Code Used

'<~~ Folder where the 3 files are
Const MyPath = "C:\Temp\"
Const xlCSV = 6
Const xlUp = -4162
Const xltoLeft = -4131
Const xlDatabase = 1
Const xlPivotTableVersion10 = 1
Const xlRowField = 1
Const xlSum = -4157

Dim oXL, oFolder, aFile, FSO
Dim wb1, wb2, ws1, ws2, wb3
Dim LastRow, pvtDataSource, MyPivotCache

Set oXL = CreateObject("Excel.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = FSO.GetFolder(MyPath)

Set wb3 = oXL.Workbooks.Add
wb3.Worksheets(1).Range("A1").Value = "Acct Num"
wb3.Worksheets(1).Range("B1").Value = "Data End Dat"
wb3.Worksheets(1).Range("C1").Value = "BPS"
wb3.Worksheets(1).Range("D1").Value = "Billable Avg Dly Bal"
wb3.Worksheets(1).Range("E1").Value = "ABB"
        
'~~> Loop through each folder to get the file name
For Each aFile In oFolder.Files
    '~~> Check if it is an excel file
    If Right(LCase(aFile.Name), 4) = ".xls" Then
        Set wb1 = oXL.Workbooks.Open(MyPath & aFile.Name)
        Set ws1 = wb1.Sheets("ABB")

        r = wb3.Worksheets(1).Range("A" & wb3.Worksheets(1).Rows.Count).End(xlUp).Row + 1
        
        oXL.Visible = True
        With ws1
            '~~> Clean UP
            .Rows("1:5").Delete
            .Range("A:C,E:E").Delete
            LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
            
            .Range("A2:E" & LastRow).Copy wb3.Worksheets(1).Range("A" & r)
                
            oXL.DisplayAlerts = False
            wb1.Close False
            oXL.DisplayAlerts = True
        End With
    End If
Next

With wb3.Worksheets(1)
    '~~> Clean UP
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row

    '~~> Set the Pivot Table Data Source
    pvtDataSource = "Sheet1!R1C1:R" & LastRow & "C5"

    Set ws2 = wb3.Worksheets.Add
    ws2.Name = "PvtTable"

    '~~> Add Pivot Table
    oXL.ActiveWorkbook.PivotCaches.Add(xlDatabase, pvtDataSource).CreatePivotTable "'PvtTable'!R3C1", _
    "PivotTable1", xlPivotTableVersion10
End With
        
'~~> Set the Fields
With ws2.PivotTables("PivotTable1").PivotFields("Acct Num")
    .Orientation = xlRowField
    .Position = 1
End With
        
ws2.PivotTables("PivotTable1").AddDataField oXL.ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("ABB"), "Sum of ABB", xlSum
        
ws2.Copy

Set wb2 = oXL.Workbooks(oXL.ActiveWorkbook.Name)
        
'~~> Save As csv
wb2.SaveAs MyPath & "Report.csv", xlCSV

oXL.DisplayAlerts = False
wb2.Close False
wb3.Close False
oXL.DisplayAlerts = True

Set wb1 = Nothing
Set ws1 = Nothing
Set wb2 = Nothing
Set ws2 = Nothing
Set wb3 = Nothing
Set oFolder = Nothing
oXL.Quit
Set oXL = Nothing

Open in new window

0
 
LVL 1

Author Comment

by:ITDeptAtPCS
ID: 35443577
Great, that works as it should.  I had a lump in my throat for a second when I manually checked the total for one of the accounts, but double checking cleared that up.

I again thank you Sid for working through this for me!  You're a true asset to the EE community!
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35443583
Glad to be of help :)

Sid
0
 
LVL 1

Author Comment

by:ITDeptAtPCS
ID: 35515212
Hey Sid, I have another file with similar requirements if you are interested.  Thanks for before again!
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_26991965.html
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…

830 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question