wally_davis
asked on
Iterating through a collection of cells and only capturing those cells data whose value is > 0
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
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
sorry, replace the ; for ,
=if(B2>0,A2,"")
=if(B2>0,A2,"")
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
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
Sorry, you need to append column B as well. Oops.
Revised below
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
ASKER
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
If cl > 0 Then
If Not chRng Is Nothing Then
Set chRng = Union(chRng,cl,cl.Offset(0
Else
Set chRng = Union(cl,cl.Offset(0,1))
End If
End If
ASKER
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.
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
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
ASKER
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...
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...
ASKER
FYI, the values in Col A are strings and the values in Column B are integers.
ASKER
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...
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...
ASKER
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?
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.
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
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
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
Sorry for the misunderstanging. I think that will solve the issue.
ASKER
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:C 21").Selec t
.ActiveChart.SetSourceData Source:=chRng 'Range("Sheet1!$A$20:$C$21 ")
End With
With .Sheets("Sheet1")
.ActiveSheet.Shapes.AddCha rt.Select
.ActiveChart.ChartType = xl3DPie
'.ActiveChart.SetSourceDat a Source:=chRng
.ActiveChart.ApplyDataLabe ls
.ActiveChart.SeriesCollect ion(1).Dat aLabels.Sh owValue = True
.ActiveChart.SeriesCollect ion(1).Dat aLabels.Sh owPercenta ge = 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").Hei ght
.ActiveSheet.Shapes("Chart 1").Width = Sheet1.Range("A4:D17").Wid th
End With
End With
End Sub
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:C
.ActiveChart.SetSourceData
End With
With .Sheets("Sheet1")
.ActiveSheet.Shapes.AddCha
.ActiveChart.ChartType = xl3DPie
'.ActiveChart.SetSourceDat
.ActiveChart.ApplyDataLabe
.ActiveChart.SeriesCollect
.ActiveChart.SeriesCollect
.ActiveSheet.Shapes("Chart
.ActiveSheet.Shapes("Chart
.ActiveSheet.Shapes("Chart
.ActiveSheet.Shapes("Chart
End With
End With
End Sub
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
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
ASKER
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?
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?
ASKER
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".
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()
I think one of the following should work
oExcel.Union()
oExcel.Application.Union()
ASKER
I still get the same error.
ASKER
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.
I'll read through it and some other examples to see if I can make sense of it.
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?
ASKER
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.Applic ation")
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.
Create Excel Object and Workbook
Dim oExcel As Excel.Application
Set oExcel = CreateObject("Excel.Applic
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
ASKER
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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.
ASKER
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.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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.
Go ahead and upload your code and let me have a look. We will get it figured out.
ASKER
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.
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
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
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
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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.FormulaR 1C1.Formul aR1C1(1,1) , Value = "Hold thru rollout-WB server" and Expression chRng.FormulaR1C1.FormulaR 1C1.Formul aR1C1(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. :)
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.FormulaR
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. :)
ASKER
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.
"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.
ASKER
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,'She et2'!$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?
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,'She
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?
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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.
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.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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.
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
Cheers,
WC
ASKER
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!
-RK