Solved

Iterating through a collection of cells and only capturing those cells data whose value is > 0

Posted on 2011-02-25
41
456 Views
Last Modified: 2012-06-21
This is going to be a challenge. This is a small test in comparision to the data (within rows and columns on Sheet2) I want to extract from Sheet2.
Sheet2 has the following ranges: A3:B54 (however, the code below shows ranges A20:C21). In Column A, is the name of a specific Patch Status (51 in all). In Column B, there will be a number from 0 to Max.
If you look in the With oExcel code below, accessCount, loginCount and wolCount will have a value of 0 or better. Now, in the Sub AddChart, there is the .Range selection method that will capture all of the Patch Statuses and their values. My question is how can I extract or select only specific ranges that have a value > 0. It appears as if the Range method in the AddChart subroutine is not the solution I'm looking for. Does anyone have a small sample of code or how I could actually build and store the specific ranges I need so that the Chart will only graph those values greater than 0? I'm hoping there is an easy solution that I can put within the AddChart sub.

Thanks for your help and input Experts,
Wallace
With oExcel
        .Cells(21, 1).Value = accessCount
        .Cells(21, 2).Value = loginCount
        .Cells(21, 3).Value = wolCount
    End With


Sub AddChart(oExcel)

    With oExcel
        On Error Resume Next

        .ActiveSheet.Range("A20:C21").Select
        .ActiveSheet.Shapes.AddChart.Select
        .ActiveChart.ChartType = xl3DPie
        .ActiveChart.SetSourceData Source:=Range("Sheet1!$A$20:$C$21")
        .ActiveChart.ApplyDataLabels
        .ActiveChart.SeriesCollection(1).DataLabels.ShowValue = True
        .ActiveChart.SeriesCollection(1).DataLabels.ShowPercentage = False
        .ActiveSheet.Shapes("Chart 1").Left = Sheet1.Cells(4, 1).Left
        .ActiveSheet.Shapes("Chart 1").Top = Sheet1.Cells(4, 1).Top
        .ActiveSheet.Shapes("Chart 1").Height = Sheet1.Range("A4:D17").Height
        .ActiveSheet.Shapes("Chart 1").Width = Sheet1.Range("A4:D17").Width

    End With
    
End Sub

Open in new window

0
Comment
Question by:wally_davis
  • 22
  • 17
  • 2
41 Comments
 
LVL 5

Expert Comment

by:roger_karam
Comment Utility
I'm not sure if the chart function can "skip" cells. The easiest way might be creating hidden columns, ie. F, G, where F2 = if(B2>0;A2;"") and chart from that column instead....
-RK
0
 
LVL 5

Expert Comment

by:roger_karam
Comment Utility
sorry, replace the ; for ,

=if(B2>0,A2,"")
0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
You can use discontinuous ranges in a chart.  One way to determine your range would be to loop through all the cells you need to check and append them using a Union.

Try the below code and see if that does what you are wanting.

WC
Sub AddChart(oExcel)
	Dim chRng as Range
	Dim cl as Range
	
    With oExcel.ActiveSheet
	For each cl in .Range("A3:A54")  'You could use .Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row) if the number of items in col A is not static
		If cl > 0 Then
			If Not chRng Is Nothing Then
				Set chRng = Union(chRng,cl)
			Else
				Set chRng = cl
			End If
		End If
	Next cl
        On Error Resume Next

        chRng.Select
        .Shapes.AddChart.Select
        .ActiveChart.ChartType = xl3DPie
        .ActiveChart.SetSourceData Source:=chRng
        .ActiveChart.ApplyDataLabels
        .ActiveChart.SeriesCollection(1).DataLabels.ShowValue = True
        .ActiveChart.SeriesCollection(1).DataLabels.ShowPercentage = False
        .ActiveSheet.Shapes("Chart 1").Left = Sheet1.Cells(4, 1).Left
        .ActiveSheet.Shapes("Chart 1").Top = Sheet1.Cells(4, 1).Top
        .ActiveSheet.Shapes("Chart 1").Height = Sheet1.Range("A4:D17").Height
        .ActiveSheet.Shapes("Chart 1").Width = Sheet1.Range("A4:D17").Width
      On Error GoTo 0
    End With
    
End Sub

Open in new window

0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
Sorry, you need to append column B as well.  Oops.

Revised below
Sub AddChart(oExcel)
	Dim chRng as Range
	Dim cl as Range
	
    With oExcel.ActiveSheet
	For each cl in .Range("A3:A54")  'You could use .Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row) if the number of items in col A is not static
		If cl > 0 Then
			If Not chRng Is Nothing Then
				Set chRng = Union(chRng,cl,cl.Offset(0,1))
			Else
				Set chRng = Union(cl,cl.Offset(0,1))
			End If
		End If
	Next cl
        On Error Resume Next

        chRng.Select
        .Shapes.AddChart.Select
        .ActiveChart.ChartType = xl3DPie
        .ActiveChart.SetSourceData Source:=chRng
        .ActiveChart.ApplyDataLabels
        .ActiveChart.SeriesCollection(1).DataLabels.ShowValue = True
        .ActiveChart.SeriesCollection(1).DataLabels.ShowPercentage = False
        .ActiveSheet.Shapes("Chart 1").Left = Sheet1.Cells(4, 1).Left
        .ActiveSheet.Shapes("Chart 1").Top = Sheet1.Cells(4, 1).Top
        .ActiveSheet.Shapes("Chart 1").Height = Sheet1.Range("A4:D17").Height
        .ActiveSheet.Shapes("Chart 1").Width = Sheet1.Range("A4:D17").Width
      On Error GoTo 0
    End With
    
End Sub

Open in new window

0
 

Author Comment

by:wally_davis
Comment Utility
Hey WarCrimes, out of the 5 rows of data (Column B) specifically, there were two rows with values greater than 0 but this code here didn't find it. (I'm still trying to figure out what chRng is storing)-->
If cl > 0 Then
                  If Not chRng Is Nothing Then
                        Set chRng = Union(chRng,cl,cl.Offset(0,1))
                  Else
                        Set chRng = Union(cl,cl.Offset(0,1))
                  End If
            End If
0
 

Author Comment

by:wally_davis
Comment Utility
Sorry, 51 rows (not 5) of Patch Status (string data in Column A) and Integer values of 0 or greater (Column B). I never see the chRng variable get updated when stepping through the code.
0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
chRng is simply storing a range object.  The Union function concatenates multiple ranges into one.

The first time you hit a cell (cl) >0 it should set the chRng = that cell and the corresponding value from Col B.

After that, each time you see cl > 0, that row is appended to the chRng with the Union function.

When you step through the code is it ever hitting the lines where Set chRng = is located?  I'm wondering if the If cl > 0 always evaluates to False.  Are the values in Col A numeric?  If they are text use this condition instead

If cDbl(cl) > 0 Then
0
 

Author Comment

by:wally_davis
Comment Utility
WC, well the first issue I run into is there is a type mismatch. i.e. cDbl(cl) when cl is of type Range.
Now, it always hits this line of code --> Set chRng = Union(cl, cl.Offset(0, 1)) but it never hits the first one whereby it should in reality store two (2) rows ranges (row, col).

I also noticed that the chRng object isn't getting Set or created until after the If conditional statement (i.e. If Not chRng Is Nothing Then ....). By that I mean, wouldn't chRng always evaluate to Nothing if it hasn't been created yet? I know it has been declared as Range but not being created until after If statement. I'll wait for reply...
0
 

Author Comment

by:wally_davis
Comment Utility
FYI, the values in Col A are strings and the values in Column B are integers.
0
 

Author Comment

by:wally_davis
Comment Utility
ok, I've stepped through the code and have changed it to this:
If cl.Offset(0, 1) > 0 Then
                    If Not chRng Is Nothing Then
                        Set chRng = Union(chRng, cl, cl.Offset(0, 1))
                    Else
                        Set chRng = Union(cl, cl.Offset(0, 1))
                    End If
                End If
Now, for instance, when Union sees the value of "MyBank" in the variable arg of "cl" and then the value of "5" in the property of cl.Offset(0,1), when the call to Set chRng  occurs, i.e. Set chRng = Union(cl, cl.Offset(0, 1)), chRng = Nothing. Back to the drawing board...
0
 

Author Comment

by:wally_davis
Comment Utility
I'm no I keep rambling but I'm thinking this all through. If chRng is an object that has methods and properties, I'm wondering if there is a method or property that needs to be set in order to build an array of the row and column ranges?
0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
Ok, first.  I'm not sure why you are getting a type mismatch.  See my example below.  It works fine on some test data stored as Text.

0
1.2
3
4,000
0
6
1
5
6
4

The Debug.Print give me the following range address
$A$2:$B$4,$A$6:$B$10

Second, chRng will evaluate to Nothing before you have seen a value > 0.  After that, you should have stepped through a Set chRng statement, therefore, chRng is no longer Nothing.
Sub meet()
    Dim cl As Range
    Dim rng As Range
    Dim chRng As Range
    
    Set rng = Range("A1:A10")
    For Each cl In rng
        If CDbl(cl) > 0 Then
            If Not chRng Is Nothing Then
                Set chRng = Union(chRng, cl, cl.Offset(0, 1))
            Else
                Set chRng = Union(cl, cl.Offset(0, 1))
            End If
        End If
    Next cl
    Debug.Print chRng.Address
End Sub

Open in new window

0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
I thought your Col A have Numbers stored as Text.  If it is really text then that explains the type mismatch.

You said you wanted to capture Values in Col A > 0.  Or at least that is what I thought.  Did you mean when the value in Col B > 0?  If so, just change my code to the below

WC
Sub AddChart(oExcel)
	Dim chRng as Range
	Dim cl as Range
	
    With oExcel.ActiveSheet
	For each cl in .Range("B3:B54")  'You could use .Range("B3:A" & Range("B" & Rows.Count).End(xlUp).Row) if the number of items in col B is not static
		If cl > 0 Then
			If Not chRng Is Nothing Then
				Set chRng = Union(chRng,cl.Offset(0,-1),cl)
			Else
				Set chRng = Union(cl.Offset(0,-1),cl)
			End If
		End If
	Next cl
        On Error Resume Next

        chRng.Select
        .Shapes.AddChart.Select
        .ActiveChart.ChartType = xl3DPie
        .ActiveChart.SetSourceData Source:=chRng
        .ActiveChart.ApplyDataLabels
        .ActiveChart.SeriesCollection(1).DataLabels.ShowValue = True
        .ActiveChart.SeriesCollection(1).DataLabels.ShowPercentage = False
        .ActiveSheet.Shapes("Chart 1").Left = Sheet1.Cells(4, 1).Left
        .ActiveSheet.Shapes("Chart 1").Top = Sheet1.Cells(4, 1).Top
        .ActiveSheet.Shapes("Chart 1").Height = Sheet1.Range("A4:D17").Height
        .ActiveSheet.Shapes("Chart 1").Width = Sheet1.Range("A4:D17").Width
      On Error GoTo 0
    End With
    
End Sub

Open in new window

0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
Sorry for the misunderstanging.  I think that will solve the issue.
0
 

Author Comment

by:wally_davis
Comment Utility
ok WC, you've pretty much nailed it but here's what my code looks like now. I'm also trying to do the following: 1. Graph the Chart on Sheet1 and read the Range values from Sheet2. I've written the code to read from Sheet2 but it keeps reading from Sheet1. Here's what I have so far:

Sub AddChart(oExcel)
    On Error Resume Next
   
    Dim cl As Range
    Dim rng
    Dim chRng As Range
           
    With oExcel
        With .Sheets("Sheet2")
        Set rng = Range("B3:B54")
            For Each cl In rng '
                If CDbl(cl) > 0 Then
                    If Not chRng Is Nothing Then
                        Set chRng = Union(chRng, cl, cl.Offset(0, 1))
                    Else
                        Set chRng = Union(cl, cl.Offset(0, 1))
                    End If
                End If
            Next cl

            chRng.Select
            '.ActiveSheet.Range("A20:C21").Select
            .ActiveChart.SetSourceData Source:=chRng 'Range("Sheet1!$A$20:$C$21")
        End With
       
        With .Sheets("Sheet1")
            .ActiveSheet.Shapes.AddChart.Select
            .ActiveChart.ChartType = xl3DPie
            '.ActiveChart.SetSourceData Source:=chRng
            .ActiveChart.ApplyDataLabels
            .ActiveChart.SeriesCollection(1).DataLabels.ShowValue = True
            .ActiveChart.SeriesCollection(1).DataLabels.ShowPercentage = False
            .ActiveSheet.Shapes("Chart 1").Left = Sheet1.Cells(4, 1).Left
            .ActiveSheet.Shapes("Chart 1").Top = Sheet1.Cells(4, 1).Top
            .ActiveSheet.Shapes("Chart 1").Height = Sheet1.Range("A4:D17").Height
            .ActiveSheet.Shapes("Chart 1").Width = Sheet1.Range("A4:D17").Width
        End With
    End With
End Sub
0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
When you use

Range()

without any explicit reference, it implicitly uses the ActiveSheet.  For this reason it is best to always explicitly state the parent object, unless you know you want to use the implicit default owner.

change this line

Set rng = Range("B3:B54")

to

Set rng = .Range("B3:B54")

That will loop you through the range on Sheet2, not the ActiveSheet.

Also, down lower, inside of your With .Sheets("Sheet1"), the .ActiveSheet is uneccessary and actually might cause problems in some cases.  

I think that should do it though.

Cheers,
WC
0
 

Author Comment

by:wally_davis
Comment Utility
Sounds good WC. One more caveat I know my code has and I think I know why the Set chRng variable is not getting set.

Ok, I have two modules, the one is called MAIN. and the second one is called PatchStatuses.
In the PatchStatuses module, I have declared some Global variables so that during the count of the different patch statuses, I can actually retrieve this data from the MAIN module. This is were the count on each of the Patch Statuses gets picked up and added to Sheet 2. I created the two modules so it is easier to segregate some routines and readability and prevent the MAIN module from getting overbloated with too much code.
I decided to comment out ON ERROR RESUME NEXT statement. and when it hit this code here -->
"Set chRng = Union(cl.Offset(0, -1), cl)"
I get the error "Run-time error 1004, method 'Union' of object '_Global' failed".

I attempted to redeclare the variable Dim chRng As Range TO Global chRng As Range and didn't like it. Any ideas on how to get around this bug?
0
 

Author Comment

by:wally_davis
Comment Utility
I'm not sure what I said actually has any value <been a long day>. Since the code in the AddChart() sub picks up that information from sheet2 directly, I'm still not sure why I'm getting the error "Run-time error 1004, method 'Union' of object '_Global' failed".
0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
Union is a method of the Excel application.  Since it looks like you are programming this from outside of Excel, try explicitly using the Application object.

I think one of the following should work

oExcel.Union()

oExcel.Application.Union()
0
 

Author Comment

by:wally_davis
Comment Utility
I still get the same error.
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:wally_davis
Comment Utility
WC, Since I'm reaching for straws here, I looked up an error on another webpage that might give someone like you who is much more advanced in the Excel VBA world then I am. Here's a link that might give you some insight. http://www.mrexcel.com/forum/showthread.php?t=156933
I'll read through it and some other examples to see if I can make sense of it.
0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
If you are coding this from a VB script, it is because Union is not a VB method, it belongs to the Excel application.  Is oExcel an application object?  if not, you need to define one in the code and use it for the Union method.  Can you share the line of code that actually sets oExcel before passing it to this Sub as a parameter?
0
 

Author Comment

by:wally_davis
Comment Utility
 WC, I'm actually writing code within the Excel Vba editor (i.e. Alt-F11).
  Create Excel Object and Workbook
  Dim oExcel As Excel.Application
    Set oExcel = CreateObject("Excel.Application")
    oExcel.Workbooks.Add
    oExcel.Visible = True

Then I have a lot of With oExcel, End With statements for placing of data and formatting and then I call the sub -->  Call AddChart(oExcel).

Now, I believe I was able to figue out the code I was having problems with so it now looks like the code you see below, but, it only pipes in the first piece of information (string and value data) to the chRng object but I didn't see it actually (or know where to find it in my excel vba watches window) store the second set of data.
For Each cl In rng 
                If cl > 0 Then
                    If Not chRng Is Nothing Then
                        Set chRng = .Application.Union(chRng, cl.Offset(0, -1), cl)
                    Else
                        Set chRng = .Application.Union(cl.Offset(0, -1), cl)
                    End If
                End If
            Next cl

Open in new window

0
 

Author Comment

by:wally_davis
Comment Utility
p.s. I've also noticed that my graph is charting data from within Sheet1 instead of selecting and graphing it from sheet2. So, the AddChart(oExcel) sub now looks like what you see below. Everything else in my project works except in this sub, well, that's partially working, and it makes me wonder if my problem is selecting the data from Sheet2 to graph it in Sheet1.
Sub AddChart(oExcel)
    On Error Resume Next
    
    Dim cl As Range
    Dim rng
    Dim chRng As Range
            
    With oExcel
        With .Sheets("Sheet2")
        Set rng = .Range("B3:B54")
            For Each cl In rng 'could use .Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row) if the number of items in col A is not static
                If cl > 0 Then
                    If Not chRng Is Nothing Then
                        Set chRng = .Application.Union(chRng, cl.Offset(0, -1), cl)
                    Else
                        Set chRng = .Application.Union(cl.Offset(0, -1), cl)
                    End If
                End If
            Next cl

            chRng.Select
            .ActiveChart.SetSourceData Source:=chRng
        End With
        
        With .Sheets("Sheet1")
            .Shapes.AddChart.Select
            
            .ActiveChart.ChartType = xl3DPie
            '.ActiveChart.SetSourceData Source:=chRng
            .ActiveChart.ApplyDataLabels
            .ActiveChart.SeriesCollection(1).DataLabels.ShowValue = True
            .ActiveChart.SeriesCollection(1).DataLabels.ShowPercentage = False
            .Shapes("Chart 1").Left = Sheet1.Cells(4, 1).Left
            .Shapes("Chart 1").Top = Sheet1.Cells(4, 1).Top
            .Shapes("Chart 1").Height = Sheet1.Range("A4:D17").Height
            .Shapes("Chart 1").Width = Sheet1.Range("A4:D17").Width
        End With
    End With

Open in new window

0
 
LVL 18

Accepted Solution

by:
WarCrimes earned 384 total points
Comment Utility
First, if you are writing this in Excel there is no need to create an Excel application object.  It already exists.  Second, even if you did need it, you are using early and late binding.  You only need one.

Early binding is when you declare the type of object in the Dim statement.  Late binding is when you use the CreateObject after you Dim as a generic Object.  Late binding allows you to use stuff outside of libraries that aren't Referenced.  The downside is you don't get all the helpful little hints from the VBE.  The plus side is others don't need to have the Reference in order to run your code.  Since it's Excel you doing this with, there really is no need.

I have tweaked your code a little.  The below edit works for me in Excel 2010.  Le t me know if you are still getting an error.

WC
Sub AddChart()
    Dim cl As Range
    Dim rng As Range
    Dim chRng As Range
            
    With Sheets("Sheet1")
        With Sheets("Sheet2")
        Set rng = .Range("B3:B54")
            For Each cl In rng 'could use .Range("B3:B" & Range("B" & Rows.Count).End(xlUp).Row) if the number of items in col B is not static
                If cl > 0 Then
                    If Not chRng Is Nothing Then
                        Set chRng = Union(chRng, cl.Offset(0, -1), cl)
                    Else
                        Set chRng = Union(cl.Offset(0, -1), cl)
                    End If
                End If
            Next cl
        End With
        Debug.Print chRng.Address
        .Shapes.AddChart.Select
        With ActiveChart
            .SetSourceData Source:=chRng
            .ChartType = xl3DPie
            .ApplyDataLabels
            .SeriesCollection(1).DataLabels.ShowValue = True
            .SeriesCollection(1).DataLabels.ShowPercentage = False
        End With
        With .Shapes(1)
            .Left = Sheet1.Cells(4, 1).Left
            .Top = Sheet1.Cells(4, 1).Top
            .Height = Sheet1.Range("A4:D17").Height
            .Width = Sheet1.Range("A4:D17").Width
        End With
    End With
End Sub

Open in new window

0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
I guess there is one reason you would need another Excel object.  If you are opening a second instance of Excel.  Is that what you are doing?  If not, I would get ride of that part.  If so, let me know and I will adjust my code.
0
 

Author Comment

by:wally_davis
Comment Utility
Hi WC, Ya, we seem to be regressing with respect to the code. I've readded the second instance of Excel to pass the Excel object to the AddChart () sub. Now, this sub creates the report in the original spreadsheet I'm running the code from instead of adding it to the new spreadsheet that gets created from my code. If you would like me to send you all of the code I can. The only exception is the PatchStatuses module (the module that the Main module or module 1 calls )  is proprietary and can't be sent.
0
 

Assisted Solution

by:wally_davis
wally_davis earned 0 total points
Comment Utility
Hi WC, I've rearranged some of the code. Thanks for the Debug.Print chRng.Address method. I can see that the two rows are in fact the two rows that hold a value of 5 and 46, respectively.
There are two problems that occur right after that. 1) the chRng.Select method doesn't select those two rows of data and I was thinking to myself "How could it select those two rows when they're about 20 rows apart AND those values are stored in the chRng object and not the actual rows of data in the new spreadsheet being "selected". 2) The .Shapes.Add.Select method within the "With .Sheets("Sheet1") adds the chart, but, selects some of the data within Sheet1 when I was expecting the two rows string and value data to show up in the Chart from the range in Sheet2.
My question is if these rows values are not actually selected, how do we get these methods to select them and add them to the chart?
Sub AddChart(oExcel)
    On Error Resume Next
    
    Dim cl As Range
    Dim rng As Range
    Dim chRng As Range
            
    With oExcel
            With .Sheets("Sheet2")
            Set rng = .Range("B3:B54")
                For Each cl In rng 
                    If cl > 0 Then
                        If Not chRng Is Nothing Then
                            Set chRng = .Application.Union(chRng, cl.Offset(0, -1), cl)
                        Else
                            Set chRng = .Application.Union(cl.Offset(0, -1), cl)
                        End If
                    End If
                Next cl
                Debug.Print chRng.Address
                chRng.Select
            End With
            
            With .Sheets("Sheet1")
                .Shapes.AddChart.Select
                    With .ActiveChart
                        .SetSourceData Source:=chRng
                        .ChartType = xl3DPie
                        .ApplyDataLabels
                        .SeriesCollection(1).DataLabels.ShowValue = True
                        .SeriesCollection(1).DataLabels.ShowPercentage = False
                    End With
                    With .Shapes(1)
                        .Left = Sheet1.Cells(4, 1).Left
                        .Top = Sheet1.Cells(4, 1).Top
                        .Height = Sheet1.Range("A4:D17").Height
                        .Width = Sheet1.Range("A4:D17").Width
                    End With
            End With
    End With
End Sub

Open in new window

0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
If you can upload the entire code, and workbook, that would be helpful.  I am not really sure what's going on.  You don't need to select chRng.  You can access the data stored in chRng by simply referencing the object.  Setting your Chart's .SetSourceData property takes care of this.

Go ahead and upload your code and let me have a look.  We will get it figured out.
0
 

Author Comment

by:wally_davis
Comment Utility
Thanks WC. I've added both Modules below. I've added comments through-out and I'm sure it will be easy to figure what I'm doing for yourself.
Any questions please let me know. The whole premise here is to take data in the spreadsheet, from two sheets, compare data and see where the data is the same over two months, and put that all in one Column (duplicate trend data) in the new Spreadsheet  and non-trend data in another column right next to it and then graph it in the same Sheet, Sheet1. Sheet2 holds the Patch Statuses and the number of times those statuses are found from the duplicate trend data that will be used for the Graph in Sheet1.


Option Explicit

 Sub CompareTrendData()
    ' compare two different worksheets in the active workbook
    CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")
'    compare two different worksheets in two different workbooks
'    CompareWorksheets ActiveWorkbook.Worksheets("Sheet1"), _
'        Workbooks("WorkBookName.xls").Worksheets("Sheet2")
 End Sub

Sub AddChart(oExcel)
    On Error Resume Next
    
    Dim cl As Range
    Dim rng As Range
    Dim chRng As Range
            
    With oExcel
            With .Sheets("Sheet2")
            Set rng = .Range("B3:B54")
                For Each cl In rng 
                    If cl > 0 Then
                        If Not chRng Is Nothing Then
                            Set chRng = .Application.Union(chRng, cl.Offset(0, -1), cl)
                        Else
                            Set chRng = .Application.Union(cl.Offset(0, -1), cl)
                        End If
                    End If
                Next cl
                Debug.Print chRng.Address
                chRng.Select
            End With
            
            With .Sheets("Sheet1")
                .Shapes.AddChart.Select
                    With .ActiveChart
                        .SetSourceData Source:=chRng
                        .ChartType = xl3DPie
                        .ApplyDataLabels
                        .SeriesCollection(1).DataLabels.ShowValue = True
                        .SeriesCollection(1).DataLabels.ShowPercentage = False
                    End With
                    With .Shapes(1)
                        .Left = Sheet1.Cells(4, 1).Left
                        .Top = Sheet1.Cells(4, 1).Top
                        .Height = Sheet1.Range("A4:D17").Height
                        .Width = Sheet1.Range("A4:D17").Width
                    End With
            End With
    End With
End Sub

Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
    Dim r As Long, c As Integer
    'Dim lr1 As Integer, lr2 As Long
    Dim lc1 As Integer, lc2 As Integer
    Dim sl1 As Integer, sl2 As Integer
    Dim maxC As Integer, maxSrvrs As Integer
    Dim cf1 As String, cf2 As String
    
    Dim Server As String
    Dim sRange As Integer
    Dim iCount As Integer
    
    Dim sht1ColA As String, sht1ColB As String
    Dim sht2ColA As String, sht2ColB As String
    Dim sht1CellA As Range, sht2CellA As Range
    Dim sht1CellB As String, sht2CellB As String
    
    Dim arrServers As Variant
    Dim dictA As Dictionary, dictB As Dictionary
    Dim itemA As Variant, itemB As Variant
     
    'Create Excel Object and Workbook
    Dim oExcel As Excel.Application
    Set oExcel = CreateObject("Excel.Application")
    oExcel.Workbooks.Add
    oExcel.Visible = True
    
'    Dim row_Count_A As Integer: row_Count_A = ActiveWorkbook.Sheets(ws1.Name).Range("A65536").End(xlUp).row
'    Dim row_Count_B As Integer: row_Count_B = ActiveWorkbook.Sheets(ws2.Name).Range("A65536").End(xlUp).row
    
    'This one line of code could resolve the problem where if, for example, one column, column A
    'the data ends at say row 50 but in column B it went to row 55.
    Dim rCount As Integer: rCount = ActiveWorkbook.ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).row
    
    'Excel Headers for Sheet1 (Graph/Trend data)
    With oExcel.Sheets(1)
        .Cells(1, 1).Value = "** Server error trends **"
        .Cells(23, 1).Value = "Duplicate errors"
        .Cells(23, 4).Value = "Non-Duplicate errors"
        .Cells(24, 1).Value = "Servername"
        .Cells(24, 2).Value = "Error data"
        .Cells(24, 4).Value = "Servername"
        .Cells(24, 5).Value = "Error data (prior month)"
        .Cells(24, 6).Value = "Error data (current month)"
    End With
    
    'Sheet1 - Excel Range/Formatting
    With oExcel
        .Cells(1, 1).Select
        .Selection.Font.Bold = True
        .Selection.Font.Italic = True
        .Selection.Font.ColorIndex = 1
        .Selection.Font.Name = "Cambria"
        .Selection.Font.Size = 14
        .Selection.Font.Bold = False
        .Cells(23, 1).Select
        .Selection.Interior.ColorIndex = 49
        .Selection.Font.Name = "Tahoma"
        .Selection.Font.ColorIndex = 2
        .Selection.Font.Size = 11
        .Selection.Font.Bold = True
        .Cells(23, 4).Select
        .Selection.Interior.ColorIndex = 49
        .Selection.Font.Name = "Tahoma"
        .Selection.Font.ColorIndex = 2
        .Selection.Font.Size = 11
        .Selection.Font.Bold = True
        .Range("A24", "B24").Select
        .Selection.Interior.ColorIndex = 1
        .Selection.Font.Name = "Tahoma"
        .Selection.Font.ColorIndex = 2
        .Selection.Font.Size = 11
        .Range("D24", "F24").Select
        .Selection.Interior.ColorIndex = 1
        .Selection.Font.Name = "Tahoma"
        .Selection.Font.ColorIndex = 2
        .Selection.Font.Size = 11
        
        .Columns("D").ColumnWidth = 3
        'END Excel Range/Formatting
    
        .ScreenUpdating = True
        .StatusBar = "Creating the report..."
        .DisplayAlerts = False
    End With
    
    'Excel Headers for Sheet2 (Patch Status count)
    With oExcel.Sheets(2)
        .Cells(3, 1).Value = "Completed"
        .Cells(4, 1).Value = "Completed manually no console issue"
        .Cells(5, 1).Value = "Completed manually-console issue"
        .Cells(6, 1).Value = "Completed at build time"
        .Cells(7, 1).Value = "Completed, but PRB ticket opened"
        .Cells(8, 1).Value = "Completed, RILO fix, no PRB ticket"
        .Cells(9, 1).Value = "Completed patch attempt, no remote scan"
        .Cells(10, 1).Value = "Deferred Resource Shortage"
        .Cells(11, 1).Value = "Deferred per Cust request"
        .Cells(12, 1).Value = "On-Hold-Approved exception:Update Not Tested AND Current Level Stable for >= 6 mth"
        .Cells(13, 1).Value = "On-Hold-Approved exception:Patch/Firmware issue"
        .Cells(14, 1).Value = "Hold thru rollout-pending decommission"
        .Cells(15, 1).Value = "Hold thru rollout, due to login problem"
        .Cells(16, 1).Value = "Hold thru this rollout-Full filesys"
        .Cells(17, 1).Value = "Hold thru rollout-console issue"
        .Cells(18, 1).Value = "Hold pending non-patch-related work"
        .Cells(19, 1).Value = "On-Hold-Approved exception:Pending Decomm"
        .Cells(20, 1).Value = "On-Hold-Needs Retro-Patching"
        .Cells(21, 1).Value = "Hold thru rollout, per Cust request"
        .Cells(22, 1).Value = "On-Hold-Approve exception:Pending TechRefresh"
        .Cells(23, 1).Value = "Hold thru rollout-unsupported OS"
        .Cells(24, 1).Value = "Hold thru rollout-WB server"
        .Cells(25, 1).Value = "Hold thru rollout, due to not pingable"
        .Cells(26, 1).Value = "Needs schedule date"
        .Cells(27, 1).Value = "Need to reschedule per Patch_id/LP_id"
        .Cells(28, 1).Value = "Tentatively Scheduled"
        .Cells(29, 1).Value = "Tentative Schedule on Tentative Window"
        .Cells(30, 1).Value = "Postponed-pending build/rebuild/upgrade"
        .Cells(31, 1).Value = "Postponed-resolvable login issue"
        .Cells(32, 1).Value = "Postponed due to Full filesys"
        .Cells(33, 1).Value = "Postponed-resolvable console issue"
        .Cells(34, 1).Value = "Postponed PRB ticket opened"
        .Cells(35, 1).Value = "Postponed due to Customer request"
        .Cells(36, 1).Value = "Postponed - Insufficient Time to Complete"
        .Cells(37, 1).Value = "Postponed-resolvable not pingable"
        .Cells(38, 1).Value = "Reboot still required patches deployed"
        .Cells(39, 1).Value = "Scheduled"
        .Cells(40, 1).Value = "Unsupported-approved exception"
        .Cells(41, 1).Value = "Unsupported due to Lab Server Frequently Rebuilt"
        .Cells(42, 1).Value = "Unsupported due to non TENAD domain"
        .Cells(43, 1).Value = "Unsupported due to no login permitted"
        .Cells(44, 1).Value = "Unsupported due to no console"
        .Cells(45, 1).Value = "Unsupported pending Operation Readiness"
        .Cells(46, 1).Value = "Unsupported not at current patch level"
        .Cells(47, 1).Value = "Unsupported Server in Quarantine"
        .Cells(48, 1).Value = "Unsupported-No RDP/no remote srv mgmt"
        .Cells(49, 1).Value = "Unsupported for patching per Cust request"
        .Cells(50, 1).Value = "Unsupported OS Version"
        .Cells(51, 1).Value = "Unsupported due to not pingable"
        .Cells(52, 1).Value = "Unsupported for patching"
        .Cells(53, 1).Value = "Validation by Patch Team still required"
        .Cells(54, 1).Value = "Other"
    End With
    
    'Sheet2 - Excel Range/Formatting
    With oExcel
        With .Sheets("Sheet2")
            With .Range("A3", "A54")
                '.Interior.ColorIndex = 2
                .Font.Name = "Tahoma"
                .Font.ColorIndex = 1
                .Font.Size = 10
                .Font.Italic = True
            End With
        End With
    End With

    While Worksheets.Count > 2
        Worksheets(2).Delete
    Wend
    
    'WorkSheet1 column count
    With ws1.UsedRange
        lc1 = .Columns.Count
    End With

    'WorkSheet2 column count
    With ws2.UsedRange
        lc2 = .Columns.Count
    End With
    
    'assigning row/column count
    maxC = lc1
    maxSrvrs = rCount 'row_Count_A
    
    'compare count of worksheets columns and rows to
    'see which worksheet has most rows of data in order
    'to set maximum rows (maxR) upper limit correctly
'    If row_Count_A < row_Count_B Then
'        row_Count_A = row_Count_B And maxSrvrs = row_Count_B
'    End If
    If maxC < lc2 Then maxC = lc2
      
    'Server collection
    Set dictA = New Dictionary
    Set dictB = New Dictionary
    dictA.CompareMode = BinaryCompare
    dictB.CompareMode = BinaryCompare
    
    iCount = 2
    
    sht1ColA = "A" & iCount
    sht1ColB = "B" & iCount
    sht2ColA = "A" & iCount
    sht2ColB = "B" & iCount
    
    'retrieve respective servername and error data from spreadsheet
    'and store in dictionary to prepare writing to files.
    For Each sht1CellA In Sheet1.Range(sht1ColA & ":" & "A" & maxSrvrs)
            sht1ColA = "A" & iCount
            sht1ColB = "B" & iCount
            sht1CellA = Replace(sht1CellA, """", "")
            sht1CellB = Sheet1.Range(sht1ColB).Value
            sht1CellB = Replace(sht1CellB, """", "")
            If sht1CellA = "" Or sht1CellA = "," Or sht1CellA = ", " Or _
                sht1CellB = "" Or sht1CellB = "," Or sht1CellB = ", " Then
                dictA.Remove (sht1CellA)
            Else
                dictA.Add sht1CellA, sht1CellB
            End If
            iCount = iCount + 1
    Next sht1CellA
    
'            For Each itemA In dictA.Keys
'                MsgBox "Server Name = " & itemA & " and " & "Error = " & dictA.Item(itemA)
'            Next itemA
    
    iCount = 2
    For Each sht2CellA In Sheet2.Range(sht2ColA & ":" & "A" & maxSrvrs)
        sht2ColA = "A" & iCount
        sht2ColB = "B" & iCount
        sht2CellA = Replace(sht2CellA, """", "")
        sht2CellB = Sheet2.Range(sht2ColB).Value
        sht2CellB = Replace(sht2CellB, """", "")
        If sht2CellA = "" Then
            dictB.Remove (sht2CellA)
            'dictB.Add "EMPTY" & iCount, sht2CellB
        Else
            dictB.Add sht2CellA, sht2CellB
        End If
        iCount = iCount + 1
    Next sht2CellA
    
    Dim ws As WshShell
    Set ws = CreateObject("WScript.Shell")
    Dim oFSO As FileSystemObject
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Dim sProfile As String: sProfile = ws.ExpandEnvironmentStrings("%UserName%")
    Dim sDictAPath As String: sDictAPath = "C:\Documents and Settings\" & sProfile & "\Desktop\dictA.txt"
    Dim sDictBPath As String: sDictBPath = "C:\Documents and Settings\" & sProfile & "\Desktop\dictB.txt"
    Dim oInputFileA As TextStream, oInputFileB As TextStream
    Dim sLinesA As Variant, sLinesB As Variant
    Dim elementA As Variant, elementB As Variant
    Dim arrIdxElementA As Variant, arrIdxElementB As Variant
    
    '---- BEGIN Create dictA and dictB.txt files to hold Server names and failures ----
    Open sDictAPath For Output As #1

    'Take data in dictionary and write to files
    
    For Each itemA In dictA.Keys
        If Not (IsEmpty(itemA)) Or (IsNull(itemA)) Or (itemA = "") Or ((itemA) Is Nothing) Then
            Write #1, itemA, dictA.Item(itemA)
        Else
            Write #1, "no data", "no data"
        End If
    Next itemA
    
    Close #1
    
    Open sDictBPath For Output As #2
    
    For Each itemB In dictB.Keys
        If Not (IsEmpty(itemB)) Or (IsNull(itemB)) Or (itemB = "") Or ((itemB) Is Nothing) Then
            Write #2, itemB, dictB.Item(itemB)
        Else
            Write #2, "no data", "no data"
        End If
    Next itemB
    
    Close #2
    '---- END Creation of dictA.txt & dictB.txt files to hold Server names and failures ----

    Set oInputFileA = oFSO.OpenTextFile(sDictAPath, ForReading)
    Set oInputFileB = oFSO.OpenTextFile(sDictBPath, ForReading)
    
    Dim match_Row As Integer: match_Row = 25
    Dim no_Match_Row As Integer: no_Match_Row = 25
    Dim lineA As Variant
    Dim accessCount As Integer, loginCount As Integer, wolCount As Integer
    
    'retrieve all servernames and errors from Sheet1
    While Not oInputFileA.AtEndOfLine
            sLinesA = oInputFileA.ReadAll
            sLinesA = Split(Trim(Replace(sLinesA, """", "")), vbCrLf)
    Wend
             
    'retrieve all servernames and errors from Sheet2
    While Not oInputFileB.AtEndOfStream
        sLinesB = oInputFileB.ReadAll
        sLinesB = Split(Trim(Replace(sLinesB, """", "")), vbCrLf)
        'Get Servername from Sheet1 collection
            For Each elementA In sLinesA
                'if elementA has no more data (i.e. subscript
                'out of range) in the array then exit else
                'goto elementB foreach loop
                If Not elementA = "" Or elementA = Null Then
                    arrIdxElementA = Split(elementA, ",")
                    'Get Servername from Sheet2 collection
                    For Each elementB In sLinesB
                        'if elementB has no data (subscript out of range)
                        'exit, else process and compare elementsA & B.
                        If Not elementB = "" Then
                            arrIdxElementB = Split(elementB, ",")
                            'if server pulled from SheetA matches
                            'server in SheetB compare their errors
                            If arrIdxElementA(0) = arrIdxElementB(0) Then
                               'Trend Errors match - highlight matching errors
                                If arrIdxElementA(1) = arrIdxElementB(1) Then
                                
                                    'Let's Categorize patch statuses that will
                                    'be used to graph trends
                                    Call PatchStatuses.Categorize(arrIdxElementA(1))
                                    
                                    With oExcel
                                        .Cells(match_Row, 1).Value = arrIdxElementA(0)
                                        .Cells(match_Row, 1).Select
                                        .Selection.Interior.ColorIndex = 27
                                        .Cells(match_Row, 2).Value = arrIdxElementA(1)
                                        .Cells(match_Row, 2).Select
                                        .Selection.Interior.ColorIndex = 27
                                    End With
                                    match_Row = match_Row + 1
                                    Exit For
                                'Trend Errors don't match No highlighting of data.
                                ElseIf arrIdxElementA(1) <> arrIdxElementB(1) Then
                                    'MsgBox "Errors don't match."
                                    oExcel.Cells(no_Match_Row, 4).Value = arrIdxElementA(0)
                                    oExcel.Cells(no_Match_Row, 5).Value = arrIdxElementA(1)
                                    oExcel.Cells(no_Match_Row, 6).Value = arrIdxElementB(1)
                                    no_Match_Row = no_Match_Row + 1
                                    Exit For
                                End If
                            End If
                        Else
                            Exit For
                        End If
                    Next
                Else
                    Exit For
                End If
            Next
    Wend

    'Total Count of all Patch Statuses to be
    'graphed in the AddChart() Subroutine
    With oExcel.Sheets(2)
        .Cells(3, 2).Value = PatchStatuses.completed
        .Cells(4, 2).Value = PatchStatuses.compManNCIssue
        .Cells(5, 2).Value = PatchStatuses.compManConIssue
        .Cells(6, 2).Value = PatchStatuses.compBldTime
        .Cells(7, 2).Value = PatchStatuses.compPrbOpened
        .Cells(8, 2).Value = PatchStatuses.compRiloFix
        .Cells(9, 2).Value = PatchStatuses.compNRScan
        .Cells(10, 2).Value = PatchStatuses.defRShortage
        .Cells(11, 2).Value = PatchStatuses.defCustReq
        .Cells(12, 2).Value = PatchStatuses.onHldNotTested
        .Cells(13, 2).Value = PatchStatuses.onHldPFIssue
        .Cells(14, 2).Value = PatchStatuses.hldPendDecom
        .Cells(15, 2).Value = PatchStatuses.hldLoginProb
        .Cells(16, 2).Value = PatchStatuses.hldFullFilesys
        .Cells(17, 2).Value = PatchStatuses.hldConIssue
        .Cells(18, 2).Value = PatchStatuses.hldNonPatchRelated
        .Cells(19, 2).Value = PatchStatuses.onHldPendDecom
        .Cells(20, 2).Value = PatchStatuses.onHldNeedsRetro
        .Cells(21, 2).Value = PatchStatuses.hldCustReq
        .Cells(22, 2).Value = PatchStatuses.onHldPendRefresh
        .Cells(23, 2).Value = PatchStatuses.hldUnsupOS
        .Cells(24, 2).Value = PatchStatuses.hldWBServer
        .Cells(25, 2).Value = PatchStatuses.hldNotPingable
        .Cells(26, 2).Value = PatchStatuses.needSchedDate
        .Cells(27, 2).Value = PatchStatuses.needToResched
        .Cells(28, 2).Value = PatchStatuses.tenSched
        .Cells(29, 2).Value = PatchStatuses.tenSchedTentWin
        .Cells(30, 2).Value = PatchStatuses.pstPendBRU
        .Cells(31, 2).Value = PatchStatuses.pstResLogIssue
        .Cells(32, 2).Value = PatchStatuses.pstFullFilesys
        .Cells(33, 2).Value = PatchStatuses.pstResConIssue
        .Cells(34, 2).Value = PatchStatuses.pstPrbTckt
        .Cells(35, 2).Value = PatchStatuses.pstCustReq
        .Cells(36, 2).Value = PatchStatuses.pstInsuffTime
        .Cells(37, 2).Value = PatchStatuses.pstResNotPing
        .Cells(38, 2).Value = PatchStatuses.rbtRequired
        .Cells(39, 2).Value = PatchStatuses.scheduled
        .Cells(40, 2).Value = PatchStatuses.unSuppAppExcep
        .Cells(41, 2).Value = PatchStatuses.unSuppLSFR
        .Cells(42, 2).Value = PatchStatuses.unSuppNonAdEnt
        .Cells(43, 2).Value = PatchStatuses.unSuppNoLoginPerm
        .Cells(44, 2).Value = PatchStatuses.unSuppNoCon
        .Cells(45, 2).Value = PatchStatuses.unSuppPendOR
        .Cells(46, 2).Value = PatchStatuses.unSuppNACPL
        .Cells(47, 2).Value = PatchStatuses.unSuppSrvInQuar
        .Cells(48, 2).Value = PatchStatuses.unSuppNoRDP
        .Cells(49, 2).Value = PatchStatuses.unSupPPerCustReq
        .Cells(50, 2).Value = PatchStatuses.unSuppOsVer
        .Cells(51, 2).Value = PatchStatuses.unSuppNoPing
        .Cells(52, 2).Value = PatchStatuses.unSupp
        .Cells(53, 2).Value = PatchStatuses.valReqByPTeam
        .Cells(54, 2).Value = PatchStatuses.other
    End With

    oInputFileA.Close
    oInputFileB.Close
          
          
    oExcel.StatusBar = "Formatting the report..."
    
    'xlHairline, xlThin, xlMedium, InsideHorizontal, InsideVertical
    'ActiveWindow.DisplayGridlines = False
    'Error count formatting
    With oExcel
        With .Sheets("Sheet2")
            With .Range("A3", "B54")
                On Error Resume Next
                .Select
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeRight).Weight = xlThin
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlInsideVertical).LineStyle = xlContinuous
                .Borders(xlInsideVertical).Weight = xlThin
                .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                .Borders(xlInsideHorizontal).Weight = xlThin
                On Error GoTo 0
            End With
        End With
    End With
    
    'Matched error cell range formatting
    With oExcel
        With .Sheets("Sheet1")
            With .Range("A25:B" & match_Row)
                On Error Resume Next
                .Select
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeRight).Weight = xlThin
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlInsideVertical).LineStyle = xlContinuous
                .Borders(xlInsideVertical).Weight = xlThin
                .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                .Borders(xlInsideHorizontal).Weight = xlThin
                On Error GoTo 0
            End With
        End With
    End With


    'Non-Matched error cell range formatting
    With oExcel
        With .Sheets("Sheet1")
            With .Range("D25:F" & no_Match_Row)
                On Error Resume Next
                .Select
                '.Interior.ColorIndex = 19
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeRight).Weight = xlThin
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlInsideVertical).LineStyle = xlContinuous
                .Borders(xlInsideVertical).Weight = xlThin
                .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                .Borders(xlInsideHorizontal).Weight = xlThin
                '.Range("A20").Select
                On Error GoTo 0
            End With
        End With
    End With
 
    With oExcel
        With .Sheets("Sheet1")
            With .Cells
                On Error Resume Next
                .Columns.AutoFit
                On Error GoTo 0
            End With
        End With
    End With

    'oExcel.Cells.Columns.AutoFit

    With oExcel
        With .Sheets("Sheet2")
            With .Cells
                On Error Resume Next
                .Columns.AutoFit
                On Error GoTo 0
            End With
        End With
    End With

    Call AddChart(oExcel)
    
    Dim curDate: curDate = DateSerial(Year(Now), Month(Now), Day(Now))
    Dim arrDate: arrDate = Split(curDate, "/")
    Dim mth: mth = arrDate(0)
    curDate = arrDate(0) & "-" & arrDate(1) & "-" & arrDate(2)
    Dim curTime: curTime = TimeValue(Now)
    Dim arrTime: arrTime = Split(curTime, ":")
    curTime = arrTime(0) & "." & arrTime(1) & "." & arrTime(2)
    Dim prevMonthName As String
    Dim curMonthName As String
    
    Select Case mth
        Case Is = 1
            prevMonthName = "December"
            curMonthName = "January"
        Case Is = 2
            prevMonthName = "January"
            curMonthName = "February"
        Case Is = 3
            prevMonthName = "February"
            curMonthName = "March"
        Case Is = 4
            prevMonthName = "March"
            curMonthName = "April"
        Case Is = 5
            prevMonthName = "April"
            curMonthName = "May"
        Case Is = 6
            prevMonthName = "May"
            curMonthName = "June"
        Case Is = 7
            prevMonthName = "June"
            curMonthName = "July"
        Case Is = 8
            prevMonthName = "July"
            curMonthName = "August"
        Case Is = 9
            prevMonthName = "August"
            curMonthName = "September"
        Case Is = 10
            prevMonthName = "September"
            curMonthName = "October"
        Case Is = 11
            prevMonthName = "October"
            curMonthName = "November"
        Case Is = 12
            prevMonthName = "November"
            curMonthName = "December"
    End Select
    
    Dim sReportPath As String: sReportPath = "C:\Documents and Settings\" & sProfile & "\Desktop"
    
    Dim sXlFinal: sXlFinal = sReportPath & "\" & _
        "Compare_Trend_Date_For_The_Months_Of_" & prevMonthName & "_And_" & curMonthName & _
            "Results_" & curDate & "_" & curTime & ".xlsx"
    oExcel.ActiveWorkbook.SaveAs sXlFinal
    
    oExcel.Application.StatusBar = False
    oExcel.ScreenUpdating = True
    oExcel.Quit
    
    MsgBox "The file [" & "Compare_Trend_Date_For_The_Months_Of_" & prevMonthName & "_And_" & curMonthName & _
                "Results_" & curDate & "_" & curTime & ".xlsx]" & " has been saved to your desktop", vbOKOnly, _
                    "Compare Trend Data report completed!"
    
    Set oExcel = Nothing
            
End Sub


--->  MODULE2 Named PatchStatuses  <----

Option Explicit

Global compNRScan, compManNCIssue, compManConIssue, compPrbOpened, compRiloFix, compBldTime, completed
Global defRShortage, defCustReq
Global hldWBServer, hldPendDecom, hldLoginProb, hldNotPingable
Global hldCustReq, hldUnsupOS, hldFullFilesys, hldConIssue, hldNonPatchRelated
Global needToResched, needSchedDate
Global onHldNotTested, onHldPFIssue, onHldPendRefresh, onHldPendDecom, onHldNeedsRetro
Global pstInsuffTime, pstCustReq, pstFullFilesys, pstPrbTckt, pstPendBRU, pstResConIssue
Global pstResLogIssue, pstResNotPing
Global rbtRequired
Global scheduled
Global tenSchedTentWin, tenSched
Global unSuppLSFR, unSupPPerCustReq, unSupp, unSuppOsVer, unSuppNoCon
Global unSuppNoLoginPerm, unSuppNonAdEnt, unSuppNoPing, unSuppNACPL
Global unSuppPendOR, unSuppSrvInQuar, unSuppAppExcep, unSuppNoRDP
Global valReqByPTeam
Global other

Sub Categorize(patchStatus)
    If StrComp(patchStatus, "Completed.", 1) = 0 Then
        completed = completed + 1
    ElseIf StrComp(patchStatus, "Completed mAnually no console issue", 1) = 0 Then
        compManNCIssue = compManNCIssue + 1
    ElseIf StrComp(patchStatus, "Completed manually-console issue", 1) = 0 Then
        compManConIssue = compManConIssue + 1
    ElseIf StrComp(patchStatus, "Completed at build time", 1) = 0 Then
        compBldTime = compBldTime + 1
    ElseIf StrComp(patchStatus, "Completed, but PRB ticket opened", 1) = 0 Then
        compPrbOpened = compPrbOpened + 1
    ElseIf StrComp(patchStatus, "Completed, RILO fix, no PRB ticket", 1) = 0 Then
        compRiloFix = compRiloFix + 1
    ElseIf StrComp(patchStatus, "Completed patch attempt, no remote scan", 1) = 0 Then
        compNRScan = compNRScan + 1
    ElseIf StrComp(patchStatus, "Deferred Resource Shortage", 1) = 0 Then
        defRShortage = defRShortage + 1
    ElseIf StrComp(patchStatus, "Deferred per Cust request", 1) = 0 Then
        defCustReq = defCustReq + 1
    ElseIf StrComp(patchStatus, "On-Hold-Approved exception:Update Not Tested AND Current Level Stable for >= 6 mth", 1) = 0 Then
        onHldNotTested = onHldNotTested + 1
    ElseIf StrComp(patchStatus, "On-Hold-Approved exception:Patch/Firmware issue", 1) = 0 Then
        onHldPFIssue = onHldPFIssue + 1
    ElseIf StrComp(patchStatus, "Hold thru rollout-pending decommission", 1) = 0 Then
        hldPendDecom = hldPendDecom + 1
    ElseIf StrComp(patchStatus, "Hold thru rollout, due to login problem", 1) = 0 Then
        hldLoginProb = hldLoginProb + 1
    ElseIf StrComp(patchStatus, "Hold thru this rollout-Full filesys", 1) = 0 Then
        hldFullFilesys = hldFullFilesys + 1
    ElseIf StrComp(patchStatus, "Hold thru rollout-console issue", 1) = 0 Then
        hldConIssue = hldConIssue + 1
    ElseIf StrComp(patchStatus, "Hold pending non-patch-related work", 1) = 0 Then
        hldNonPatchRelated = hldNonPatchRelated + 1
    ElseIf StrComp(patchStatus, "On-Hold-Approved exception:Pending Decomm", 1) = 0 Then
        onHldPendDecom = onHldPendDecom + 1
    ElseIf StrComp(patchStatus, "On-Hold-Needs Retro-Patching", 1) = 0 Then
        onHldNeedsRetro = onHldNeedsRetro + 1
    ElseIf StrComp(patchStatus, "Hold thru rollout, per Cust request", 1) = 0 Then
        hldCustReq = hldCustReq + 1
    ElseIf StrComp(patchStatus, "On-Hold-Approve exception:Pending TechRefresh", 1) = 0 Then
        onHldPendRefresh = onHldPendRefresh + 1
    ElseIf StrComp(patchStatus, "Hold thru rollout-unsupported OS", 1) = 0 Then
        hldUnsupOS = hldUnsupOS + 1
    ElseIf StrComp(patchStatus, "Hold thru rollout-WBank server", 1) = 0 Then
        hldWBServer = hldWBServer + 1
    ElseIf StrComp(patchStatus, "Hold thru rollout, due to not pingable", 1) = 0 Then
        hldNotPingable = hldNotPingable + 1
    ElseIf StrComp(patchStatus, "Needs schedule date", 1) = 0 Then
        needSchedDate = needSchedDate + 1
    ElseIf StrComp(patchStatus, "Need to reschedule per Patch_id/LP_id", 1) = 0 Then
        needToResched = needToResched + 1
    ElseIf StrComp(patchStatus, "Tentatively Scheduled", 1) = 0 Then
        tenSched = tenSched + 1
    ElseIf StrComp(patchStatus, "Tentative Schedule on Tentative Window", 1) = 0 Then
        tenSchedTentWin = tenSched + 1
    ElseIf StrComp(patchStatus, "Postponed-pending build/rebuild/upgrade", 1) = 0 Then
        pstPendBRU = pstPendBRU + 1
    ElseIf StrComp(patchStatus, "Postponed-resolvable login issue", 1) = 0 Then
        pstResLogIssue = pstResLogIssue + 1
    ElseIf StrComp(patchStatus, "Postponed due to Full filesys", 1) = 0 Then
        pstFullFilesys = pstFullFilesys + 1
    ElseIf StrComp(patchStatus, "Postponed-resolvable console issue", 1) = 0 Then
        pstResConIssue = pstResConIssue + 1
    ElseIf StrComp(patchStatus, "Postponed PRB ticket opened") = 0 Then
        pstPrbTckt = pstPrbTckt + 1
    ElseIf StrComp(patchStatus, "Postponed due to Customer request", 1) = 0 Then
        pstCustReq = pstCustReq + 1
    ElseIf StrComp(patchStatus, "Postponed - Insufficient Time to Complete", 1) = 0 Then
        pstInsuffTime = pstInsuffTime + 1
    ElseIf StrComp(patchStatus, "Postponed-resolvable not pingable", 1) = 0 Then
        pstResNotPing = pstResNotPing + 1
    ElseIf StrComp(patchStatus, "Reboot still required patches deployed", 1) = 0 Then
        rbtRequired = rbtRequired + 1
    ElseIf StrComp(patchStatus, "Scheduled", 1) = 0 Then
        scheduled = scheduled + 1
    ElseIf StrComp(patchStatus, "Unsupported-approved exception", 1) = 0 Then
        unSuppAppExcep = unSuppAppExcep + 1
    ElseIf StrComp(patchStatus, "Unsupported due to Lab Server Frequently Rebuilt", 1) = 0 Then
        unSuppLSFR = unSuppLSFR + 1
    ElseIf StrComp(patchStatus, "Unsupported due to non AD-ENT domain", 1) = 0 Then
        unSuppNonAdEnt = unSuppNonAdEnt + 1
    ElseIf StrComp(patchStatus, "Unsupported due to no login permitted", 1) = 0 Then
        unSuppNoLoginPerm = unSuppNoLoginPerm + 1
    ElseIf StrComp(patchStatus, "Unsupported due to no console", 1) = 0 Then
        unSuppNoCon = unSuppNoCon + 1
    ElseIf StrComp(patchStatus, "Unsupported pending Operation Readiness", 1) = 0 Then
        unSuppPendOR = unSuppPendOR + 1
    ElseIf StrComp(patchStatus, "Unsupported not at current patch level", 1) = 0 Then
        unSuppNACPL = unSuppNACPL + 1
    ElseIf StrComp(patchStatus, "Unsupported Server in Quarantine", 1) = 0 Then
        unSuppSrvInQuar = unSuppSrvInQuar + 1
    ElseIf StrComp(patchStatus, "Unsupported-No RDP/no remote srv mgmt", 1) = 0 Then
        unSuppNoRDP = unSuppNoRDP + 1
    ElseIf StrComp(patchStatus, "Unsupported for patching per Cust request", 1) = 0 Then
        unSupPPerCustReq = unSupPPerCustReq + 1
    ElseIf StrComp(patchStatus, "Unsupported OS Version", 1) = 0 Then
        unSuppOsVer = unSuppOsVer + 1
    ElseIf StrComp(patchStatus, "Unsupported due to not pingable", 1) = 0 Then
        unSuppNoPing = unSuppNoPing + 1
    ElseIf StrComp(patchStatus, "Unsupported for patching.", 1) = 0 Then
        unSupp = unSupp + 1
    ElseIf StrComp(patchStatus, "Validation by Patch Team still required", 1) = 0 Then
        valReqByPTeam = valReqByPTeam + 1
    Else
        other = other + 1
    End If
End Sub

Open in new window

0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
The code doesn't help me a whole lot without valid test data to work with.  I was hoping you could upload the workbook, but if you can't that is alright.

It's hard for me to tell what's causing the issue from the code, because on my end it works fine.  Let me try to create another Excel instance and see if I can reproduce the issue.

If not, I will put in some more debugging lines and you can send me the print out so I can maybe see what is going on.

WC
0
 
LVL 18

Assisted Solution

by:WarCrimes
WarCrimes earned 384 total points
Comment Utility
Well that was easy.  I was able to reproduce all the symptoms you have been describing, the _global error and chRng not being found.

Try changing this line

With .ActiveChart

to

 With .ChartObjects(1).Chart

Let me know if you're still getting weird results.
0
 

Author Comment

by:wally_davis
Comment Utility
WC, wow, nice job. That really fixed just about everything else with one small minor exception (not that it's a big deal but I would like to use variouls Pie Charts in my test.

Debug.Print chRng.Address = "$A$24:$B$24,$A$52:$B$52" or in plain english equates to this:
Row 24 , Column A = "Hold thru rollout-WB server" and Column B (number of duplidate trend errors between this month and last month) = 5, and then
Row 52, Column A = "Unsupported for patching" AND Column B = 46.

I supposed during this method (the selection of the two rows above):
chRng.Select
If I use the .ChartType = xlColumnClustered, then it works perfect.
However, if I set the .ChartType = xl3DPie, only the first Patch Status and it's count are getting graphed. It doesn't graph the second Patch status of "Unsupported for patching" and the number of errors equal to 46 in my 3D Pie Chart.

If I step through my code, I also noticed that the values in Row 24 of "Hold thru rollout-WB server" and "5" are in the Expression chRng.FormulaR1C1.FormulaR1C1.FormulaR1C1(1,1), Value = "Hold thru rollout-WB server" and Expression chRng.FormulaR1C1.FormulaR1C1.FormulaR1C1(1,2), Value = "5".
I don't see the Expression and Value for "Unsupported for patching" and Value = "46" but yet it gets graphed using the aforementioned .ChartType = xlColumnClustered (and not xl3DPie). I'm wondering if there is a setting to make the PieChart smaller and maybe the data is getting squeezed out of the frame. It looks like the Expression = "Hold thru rollout-WB server" for xl3DPie chart, the font is pretty large....Any thoughts. I mean, you really hit home. It would be nice just to see the 3D Pie chart work.
Fantastic work WC. :)
0
 

Author Comment

by:wally_davis
Comment Utility
FYI WC, When I hover over the actual graphical 3D Pie chart, it displays this data:
"Series Hold thru rollout-WB server Point 1 Value: 5 (100%)".

So, apparently, for whatever reason, the data extra data isn't getting applied when the chart is converted to 3D.
0
 

Author Comment

by:wally_davis
Comment Utility
One more tidbit, I decided to highlight the Graph and edit it. Here's what else I found:

There's a Category called: Legend Entries (Series) and I can see the legend values of "Hold thru rollout-WB server " and "Unsupported for patching". Then there is a Category called Horizontal (Category) Axis Labels. Number "1" is listed in there but that is it.
Chart data range: ='Sheet2'!$A$24:$B$24,'Sheet2'!$A$52:$B$52

When I click on the "Switch Row/Column" button, it displays the data the way I need to. I imagine there is some properties or methods that would be able to do this ayyy. Once this is figured out I'm home free thanks to you. And, do you know a good resource for reading up on all of this stuff. I mean, a good book?
0
 

Assisted Solution

by:wally_davis
wally_davis earned 0 total points
Comment Utility
Hey WC, I found something on one of the websites. I searched about an hour and finally found something.
.PlotBy = xlColumns
.PlotBy = xlRows

Looks like I just need to add the .PlotBy = xlColumns and that did the trick.
I need to run another test and after lunch, I'll come back and look at all the solutions you provided that helped me get this AddChart sub routine finalized. Thank you once again WarCrimes. Oh, and by the way, could you recommend any books that might possibly cover all of these scenarios? There is so much time you have to spend looking examples on the Internet that it would be much more expedient to have  a one stop shop (whether an Internet website or a good book). Thank you again! I'll look for your response.
0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
Can you supply me with the Col A and Col B you are running this on?  Just paste them in this window or attach a .txt file, if you can.  I will take a look tonight if I can.  A little swamped at work right now.  Also, can you upload pictures of how the graph looks when it is bad and what your desired result is?  That would help tremendously.

What reading material are you interested in?  Programming in VBA for Excel or Charts specifically?  I can recommend some places online.  I'm self-taught and everything I have learned has been from online and adapting things the Macro recorder does.  
0
 
LVL 18

Assisted Solution

by:WarCrimes
WarCrimes earned 384 total points
Comment Utility
Glad you got it working.

There is no real "one-stop shop" for VBA.  The most useful site in my experience is MSDN.  I learned tons about the EOM (Excel Object Model) on that site.  Anytime I need to know what properties or methods are available I go there.  You can find most of the same info in the VBE by going to the Object Browser (F2).  Just make sure to show hidden members once you have the Object Browser open (right click and select from menu).

If you have a programming background, it really is just about learning the EOM.  Most of it though is a learn-as-needed type of thing.  The great part is that the EOM is abstracted pretty well.  What I mean is that many objects and methods have similar methods and properties, so once you know the structure of one part of the EOM, it becomes easier learning other things.

Here are some links I recommended for an Excel training I did at work:
Information, Examples, Tutorials
http://www.cpearson.com/Excel/MainPage.aspx

http://www.contextures.com/tiptech.html

http://www.ozgrid.com/
Excel Solutions
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/
Blogs
http://blogs.msdn.com/excel/
http://blogs.msdn.com/bi/
Color Palette Explained
http://www.mvps.org/dmcritchie/excel/colors.htmhttp://support.softartisans.com/kbview_1205.aspx
VBA tutorials
http://msdn.microsoft.com/en-us/library/aa203714(office.11).aspx
http://office.microsoft.com/en-us/excel/HA011189581033.aspx
Excel 2003 VBA Language Reference
http://msdn.microsoft.com/en-us/library/aa272254(office.11).aspx
Links to Excel Pages
http://www.decisionmodels.com/linkssites.htm

Most of the stuff from Excel 2003 still applies to 2007/10, but obviously there are plenty of new things and some things have been removed.  It's still a good resource for most of the basic elements of the EOM.  There is also a VBA Reference for 2007 and 2010 on MSDN. Here is the link for 2010.

http://msdn.microsoft.com/en-us/library/ff846392.aspx

As for Charts, this site is often recommended.
http://peltiertech.com/index.html

If you have any other questions, just shoot a message in this thread, or ask another question here in the Excel forum.  There are plenty of Experts with lots of knowledge to share.

Cheers,
WC
0
 

Author Comment

by:wally_davis
Comment Utility
Thanks WC for the plethora of information and the bonus tip on the F2 (Object Browser) feature. I never thought to look and man, does that help out a BUNCH.
0
 
LVL 18

Expert Comment

by:WarCrimes
Comment Utility
Glad to help.  I probably was coding in VBA for a year using MSDN before I knew about the Object Broswer.  One of the Experts here pointed me to it. Imagine that. :)

Cheers,
WC
0
 

Author Closing Comment

by:wally_davis
Comment Utility
Outstanding work by WarCrimes. Each time we hit another wall in the code, you helped me get to the next phase all the way up to completion. It is a pleasure to work with Professional Experts like yourself WC. Thank you again!
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

762 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

Need Help in Real-Time?

Connect with top rated Experts

7 Experts available now in Live!

Get 1:1 Help Now