?
Solved

.VBS Script needed for use within Excel for automation

Posted on 2009-04-20
20
Medium Priority
?
314 Views
Last Modified: 2013-11-10
Hi there
I am in need of a script that can accomplish the following on a Excel Spread sheet:

1 - Open C:\myfile\myexcel.xls
2 - Create a new Worksheet called STATS
3 - Count column D for all unique items & place count at the 1st row of column D on
worksheet STATS (These are business source codes (non numeric))

The tricky part:
4 - Sum the total in column R (called sheet1) for each unque source code from the 1st worksheet, #3 was unique but for every unque source code the script found in column D I would like to know the total amount of revenue posted in column R associated to each source code (counting blanks, labeling as None) and place the total into the STATS worksheet:

Example:
COLUMNA    COLUMN B               COLUMNC          COLUMND
SOURCE1     $TOTAL_REVENUE  TOTALCOUNT   TOTALUNIQUE
SOURCE2     $TOTAL_REVENUE  TOTALCOUNT
SOURCE3     $TOTAL_REVENUE  TOTALCOUNT
None             $TOTAL_REVENUE  TOTALCOUNT

5 - Save to the same file as above
6 - close excel

Thanks as always for your help, please note I need this to be a .VBS script not VBA, this will be used within a DOS Batch file for automation purposes.

Thank you again!
0
Comment
Question by:smyers051972
  • 12
  • 6
  • 2
20 Comments
 
LVL 50

Expert Comment

by:Dave Brett
ID: 24191036
Yep, this is soundling a little tricky :)
Do you have sample file (before and final) to help guide us?
Cheers
Dave
0
 
LVL 17

Expert Comment

by:wobbled
ID: 24192988
Here to start with... Open workbook and add sheet

    Dim objExcel As Object
    Dim objWorkBook As Object
    Dim objWorkSheet As Object
    Set objExcel = CreateObject("EXCEL.APPLICATION")
    Set objWorkBook = objExcel.Workbooks.Open("C:\myfile\myexcel.xls")
   
    Set objWorkSheet = objWorkBook.Worksheets.Add(, "STATS")
   
    'now we can manipulate it just add code here
   
   
    'final part to close it
    objWorkBook.SaveAs ("C:\myfile\myexcel.xls")
    objWorkBook.Close True
    Set objWorkBook = Nothing
    Set objExcel = Nothing
0
 
LVL 17

Expert Comment

by:wobbled
ID: 24192994
Just checking you say "3 - Count column D for all unique items & place count at the 1st row of column D on
worksheet STATS (These are business source codes (non numeric))"

Which worksheet is column D on?
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
LVL 1

Author Comment

by:smyers051972
ID: 24193579
I was just typing that as my example, there are probably a few hundred or so records in some of those cases.

Lets say there are 200 (count) SOURCE1, 150 (count) SOURCE2 and 101 (count) SOURCE3 records on sheet1, I would like the above to reflect total revenue for each of those sources in the STATS worksheet.

Then the final Column D on sheet1 would be the total count of unique source codes from the first worksheet, so it should only count each source code one time for the unique count.

Let me know if that helps, if I still need to upload a sample spread sheet I will copy part of the existing XLS file I have when I get into the office (about 1 1/2 hours from now).

Thanks!
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 24193808
Pls upload the sheet. It will help with the  problem part in (3) and (4)
Cheers
Dave
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24193821
Will do dave, headed to work in a few minutes here!
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 24193864
Thx.  I'll be turning in for the night shortly, so I will have a look at this tomorrow if no-one else has picked it up in the interim :)
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24194485
Here you go as promised. I had to remove the names etc to protect the innocent :)

I bolded the two columns of interest.

sample-players.xls
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24195217
Let me re-upload, I forgot the mock up of sheet1, now its included.

Thanks!

sample-players.xls
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24195237
The more I think of it though, I want to put the total count of uniques on column D2 because I need a header for D1 to say "Uniques" on it instead of just a number.

Thanks!
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 24201923
Hope this helps  :)
Cheers
Dave

    Dim objExcel, objWorkbook, objWorksheet
    Dim objWorksheet2, objRange , objRange2
    Dim rngAddy, rngAddy2
    Dim Headers
    Headers = Array("Source","Revenue","Count","Unique")
    Set objExcel = CreateObject("Excel.Application")
    Set objWorkbook = objExcel.Workbooks.Open("C:\myfile\myexcel.xls")
    On Error Resume Next
    objExcel.DisplayAlerts = False
    objWorkbook.Sheets("Stats").Delete
    On Error GoTo 0
    Set objWorksheet = objWorkbook.Worksheets(1)
    Set objRange = objExcel.Range(objWorksheet.Range("o1"), objWorksheet.Range("o1").End(-4121))
    Set objWorksheet2 = objWorkbook.Worksheets.Add
    objWorksheet2.Name = "Stats"
    With objRange
        .AdvancedFilter 1, , , True
        .Copy objWorksheet2.Range("A1")
    End With
    objWorksheet.AutoFilterMode = False
    On Error Resume Next
    Set objRange2 = objWorksheet2.Columns("A").SpecialCells(xlBlanks)
    objRange2.EntireRow.Delete
    On Error GoTo 0
    Set objRange2 = objExcel.Range(objWorksheet2.Range("A2"), objWorksheet2.Range("A2").End(-4121))
    rngAddy = "'" & objRange.Parent.Name & "'!" & objRange.Address(, , -4150)
    rngAddy2 = "'" & objRange.Parent.Name & "'!" & objRange.Offset(0, 3).Address(,,-4150)
    objRange2.Offset(0, 2).FormulaR1C1 = "=COUNTIF(" & rngAddy & ",'Stats'!RC1)"
    objRange2.Offset(0, 1).FormulaR1C1 = "=SUMIF(" & rngAddy & ",'Stats'!RC1," & rngAddy2 & ")"
    objWorksheet2.range("A1:D1") = Headers
    objWorksheet2.range("D2") = objWorksheet2.usedrange.rows.count -1
    objWorkbook.Save
    objWorkbook.Close False
    objExcel.DisplayAlerts = True
    objExcel.Quit

Open in new window

0
 
LVL 1

Author Comment

by:smyers051972
ID: 24204025
Will test at work, if it works, you ready for part 2 of this request? =)
Ill open a new question for it of course it has to do with building a pie chart based on the above lol
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24204855
Ok only a couple issues with this script, it hides most of the report on the main worksheet I suspect after, I understand this may be required to get the uniques however after its done, how do we unhide everything from the original worksheet?

The only other issue I saw was it left auto filter off, this should be turned back on for the parent work sheet only.

Thanks!
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24205590
I added the one line after .Copy objWorksheet2.Range("A1") to unhide (figured that out) but I cant get autofilter to turn back on. Here is the changed code.

	Dim objExcel, objWorkbook, objWorksheet
    Dim objWorksheet2, objRange , objRange2
    Dim rngAddy, rngAddy2
    Dim Headers
    Headers = Array("Source","Revenue","Count","Unique")
    Set objExcel = CreateObject("Excel.Application")
    Set objWorkbook = objExcel.Workbooks.Open("D:\newplayers.xls")
    On Error Resume Next
    objExcel.DisplayAlerts = False
    objWorkbook.Sheets("Stats").Delete
    On Error GoTo 0
    Set objWorksheet = objWorkbook.Worksheets(1)
    Set objRange = objExcel.Range(objWorksheet.Range("o1"), objWorksheet.Range("o1").End(-4121))
    Set objWorksheet2 = objWorkbook.Worksheets.Add
    objWorksheet2.Name = "Stats"
    With objRange
        .AdvancedFilter 1, , , True
        .Copy objWorksheet2.Range("A1")
	    .AdvancedFilter 1, , , False
    End With
    objWorksheet.AutoFilterMode = False
    On Error Resume Next
    Set objRange2 = objWorksheet2.Columns("A").SpecialCells(xlBlanks)
    objRange2.EntireRow.Delete
    On Error GoTo 0
    Set objRange2 = objExcel.Range(objWorksheet2.Range("A2"), objWorksheet2.Range("A2").End(-4121))
    rngAddy = "'" & objRange.Parent.Name & "'!" & objRange.Address(, , -4150)
    rngAddy2 = "'" & objRange.Parent.Name & "'!" & objRange.Offset(0, 3).Address(,,-4150)
    objRange2.Offset(0, 2).FormulaR1C1 = "=COUNTIF(" & rngAddy & ",'Stats'!RC1)"
    objRange2.Offset(0, 1).FormulaR1C1 = "=SUMIF(" & rngAddy & ",'Stats'!RC1," & rngAddy2 & ")"
    objWorksheet2.range("A1:D1") = Headers
    objWorksheet2.range("D2") = objWorksheet2.usedrange.rows.count -1
    objWorkbook.Save
    objWorkbook.Close False
    objExcel.DisplayAlerts = True
    objExcel.Quit

Open in new window

0
 
LVL 1

Author Comment

by:smyers051972
ID: 24206985
I was working with it some more and made some changes I would like to keep so when you see this, and can help me fix auto filter and auto fit doesnt seem to work either, I commented it out again but here is the updated code.

Thanks again!!!

	Dim objExcel, objWorkbook, objWorksheet
    Dim objWorksheet2, objRange , objRange2
    Dim rngAddy, rngAddy2
    Dim Headers
    Headers = Array("Manufacturer","CIPUPD Revenue","Machine Count","Unique Mfrs","     ","Avg Per Ship","Avg Per Machine")
    Set objExcel = CreateObject("Excel.Application")
    Set objWorkbook = objExcel.Workbooks.Open("D:\Dailyslotreports.xls")
    On Error Resume Next
    objExcel.DisplayAlerts = False
    objWorkbook.Sheets("Stats").Delete
    On Error GoTo 0
    Set objWorksheet = objWorkbook.Worksheets(1)
    Set objRange = objExcel.Range(objWorksheet.Range("E1"), objWorksheet.Range("E1").End(-4121))
    Set objWorksheet2 = objWorkbook.Worksheets.Add
    objWorksheet2.Name = "Stats"
    With objRange
        .AdvancedFilter 1, , , True
        .Copy objWorksheet2.Range("A1")
	    .AdvancedFilter 1, , , False
        '.Columns.AutoFit 
   End With
    objWorksheet.AutoFilterMode = False
    On Error Resume Next
    Set objRange2 = objWorksheet2.Columns("A").SpecialCells(xlBlanks)
    objRange2.EntireRow.Delete
    On Error GoTo 0
    Set objRange2 = objExcel.Range(objWorksheet2.Range("A2"), objWorksheet2.Range("A2").End(-4121))
    rngAddy = "'" & objRange.Parent.Name & "'!" & objRange.Address(, , -4150)
    rngAddy2 = "'" & objRange.Parent.Name & "'!" & objRange.Offset(0, 9).Address(,,-4150)
    objRange2.Offset(0, 2).FormulaR1C1 = "=COUNTIF(" & rngAddy & ",'Stats'!RC1)"
    objRange2.Offset(0, 1).FormulaR1C1 = "=SUMIF(" & rngAddy & ",'Stats'!RC1," & rngAddy2 & ")"
    objRange2.Offset(0, 5).FormulaR1C1 = "=SUMIF(" & rngAddy & ",'Stats'!RC1," & rngAddy2 & ")/9"
    objRange2.Offset(0, 6).FormulaR1C1 = "=SUMIF(" & rngAddy & ",'Stats'!RC1," & rngAddy2 & ")/COUNTIF(" & rngAddy & ",'Stats'!RC1)"
	objWorksheet2.range("A1:G1") = Headers
    objWorksheet2.range("D2") = objWorksheet2.usedrange.rows.count -1
    objWorkbook.Save
    objWorkbook.Close False
    objExcel.DisplayAlerts = True
    objExcel.Quit

Open in new window

0
 
LVL 1

Author Comment

by:smyers051972
ID: 24207041
I did change the columns to see if I could figure it out dont worry about that I will change them back as needed, this is just me trying to learn :)
0
 
LVL 50

Accepted Solution

by:
Dave Brett earned 2000 total points
ID: 24210842
No probs :)
The code below autfotites the Stat sheet in columns A:G by using
objWorksheet2.Columns("A:G").AutoFit
Plus I have havr eremoved turning autofilter off by taking out this line
objWorksheet.AutoFilterMode = False
 
Cheers
Dave

Dim objExcel, objWorkbook, objWorksheet
Dim objWorksheet2, objRange, objRange2
Dim rngAddy, rngAddy2
Dim Headers
Headers = Array("Manufacturer", "CIPUPD Revenue", "Machine Count", "Unique Mfrs", "     ", "Avg Per Ship", "Avg Per Machine")
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("D:\Dailyslotreports.xls")
On Error Resume Next
objExcel.DisplayAlerts = False
objWorkbook.Sheets("Stats").Delete
On Error GoTo 0
Set objWorksheet = objWorkbook.Worksheets(1)
Set objRange = objExcel.Range(objWorksheet.Range("E1"), objWorksheet.Range("E1").End(-4121))
Set objWorksheet2 = objWorkbook.Worksheets.Add
objWorksheet2.Name = "Stats"
With objRange
    .AdvancedFilter 1, , , True
    .Copy objWorksheet2.Range("A1")
End With
On Error Resume Next
Set objRange2 = objWorksheet2.Columns("A").SpecialCells(xlBlanks)
objRange2.EntireRow.Delete
On Error GoTo 0
Set objRange2 = objExcel.Range(objWorksheet2.Range("A2"), objWorksheet2.Range("A2").End(-4121))
rngAddy = "'" & objRange.Parent.Name & "'!" & objRange.Address(, , -4150)
rngAddy2 = "'" & objRange.Parent.Name & "'!" & objRange.Offset(0, 9).Address(, , -4150)
objRange2.Offset(0, 2).FormulaR1C1 = "=COUNTIF(" & rngAddy & ",'Stats'!RC1)"
objRange2.Offset(0, 1).FormulaR1C1 = "=SUMIF(" & rngAddy & ",'Stats'!RC1," & rngAddy2 & ")"
objRange2.Offset(0, 5).FormulaR1C1 = "=SUMIF(" & rngAddy & ",'Stats'!RC1," & rngAddy2 & ")/9"
objRange2.Offset(0, 6).FormulaR1C1 = "=SUMIF(" & rngAddy & ",'Stats'!RC1," & rngAddy2 & ")/COUNTIF(" & rngAddy & ",'Stats'!RC1)"
objWorksheet2.Range("A1:G1") = Headers
objWorksheet2.Columns("A:G").AutoFit
objWorksheet2.Range("D2") = objWorksheet2.UsedRange.Rows.Count - 1
objWorkbook.Save
objWorkbook.Close False
objExcel.DisplayAlerts = True
objExcel.Quit
Set objExcel = Nothing

Open in new window

0
 
LVL 1

Author Closing Comment

by:smyers051972
ID: 31572574
Thank you again Dave! P.S. could you check out my other Question when you have a chance, I am not totally sure whats being said in regards to moving yellow colored (fills) of rows to the top (2nd row - 1 below headers) on excel, its baffling me. Thanks!
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 24221175
thx for the grade :)

will check out the other q

Cheers

Dave
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24225829
Thanks Dave! I have 2 open now :)
0

Featured Post

Upgrade your Question Security!

Add Premium security features to your question to ensure its privacy or anonymity. Learn more about your ability to control Question Security today.

Question has a verified solution.

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

Microsoft's Excel has many features that most people will never need nor take advantage of.  Conditional formatting is one feature that you may find a necessity once you start using it.
The SignAloud Glove is capable of translating American Sign Language signs into text and audio.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
Progress

839 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