Good Day!
I have some VBA code that I use to go through multiple worksheets and highlight cells based on certain criteria. See below for my example code. What I'm trying to accomplish is to take the same criteria and summarize it into a new worksheet that the VBA code creates. I will provide what I would like to see the output look like below. Thanks for any help on this, it's greatly appreciated!
Code:
Example output below: (The values are made up, but I would like them to be the counted result from the VBA code.
I have some VBA code that I use to go through multiple worksheets and highlight cells based on certain criteria. See below for my example code. What I'm trying to accomplish is to take the same criteria and summarize it into a new worksheet that the VBA code creates. I will provide what I would like to see the output look like below. Thanks for any help on this, it's greatly appreciated!
Code:
VBA Code:
Sub vInfoAssess
Dim ws As Worksheet: Set ws = Sheets("vInfo")
'declare and set your Sheet above, change Sheet1 as required
Dim FoundStart As Range
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the number of rows with data from Column A
Set FoundStart = ws.Rows(1).Find(What:="Reservation (CPU)")
If Not FoundStart Is Nothing Then 'if both headers are found then
For i = 2 To LastRow 'loop from row 2 to last
If ws.Cells(i, FoundStart.Column) > 0 Then '
ws.Cells(i, FoundStart.Column).Interior.ColorIndex = 6
End If
Next i
End If
Set FoundStart = ws.Rows(1).Find(What:="Limit (CPU)")
If Not FoundStart Is Nothing Then 'if both headers are found then
For i = 2 To LastRow 'loop from row 2 to last
If ws.Cells(i, FoundStart.Column) > -1 Then '
ws.Cells(i, FoundStart.Column).Interior.ColorIndex = 6
End If
Next i
End If
Set FoundStart = ws.Rows(1).Find(What:="CPU Hot Add")
If Not FoundStart Is Nothing Then 'if both headers are found then
For i = 2 To LastRow 'loop from row 2 to last
If ws.Cells(i, FoundStart.Column) = True Then '
ws.Cells(i, FoundStart.Column).Interior.ColorIndex = 6
End If
Next i
End If
Set FoundStart = ws.Rows(1).Find(What:="Swapped (MB)")
If Not FoundStart Is Nothing Then 'if both headers are found then
For i = 2 To LastRow 'loop from row 2 to last
If ws.Cells(i, FoundStart.Column) > 0 Then '
ws.Cells(i, FoundStart.Column).Interior.ColorIndex = 6
End If
Next i
End If
Set FoundStart = ws.Rows(1).Find(What:="Ballooned (MB)")
If Not FoundStart Is Nothing Then 'if both headers are found then
For i = 2 To LastRow 'loop from row 2 to last
If ws.Cells(i, FoundStart.Column) > 0 Then '
ws.Cells(i, FoundStart.Column).Interior.ColorIndex = 6
End If
Next i
End If
Set FoundStart = ws.Rows(1).Find(What:="Reservation (MEM)")
If Not FoundStart Is Nothing Then 'if both headers are found then
For i = 2 To LastRow 'loop from row 2 to last
If ws.Cells(i, FoundStart.Column) > 0 Then '
ws.Cells(i, FoundStart.Column).Interior.ColorIndex = 6
End If
Next i
End If
Set FoundStart = ws.Rows(1).Find(What:="Limit (MEM)")
If Not FoundStart Is Nothing Then 'if both headers are found then
For i = 2 To LastRow 'loop from row 2 to last
If ws.Cells(i, FoundStart.Column) > -1 Then '
ws.Cells(i, FoundStart.Column).Interior.ColorIndex = 6
End If
Next i
End If
Set FoundStart = ws.Rows(1).Find(What:="Adapter")
If Not FoundStart Is Nothing Then 'if both headers are found then
For i = 2 To LastRow 'loop from row 2 to last
If ws.Cells(i, FoundStart.Column) <> "Vmxnet3" Then '
ws.Cells(i, FoundStart.Column).Interior.ColorIndex = 6
End If
Next i
End If
Set FoundStart = ws.Rows(1).Find(What:="Disk Reservation)")
If Not FoundStart Is Nothing Then 'if both headers are found then
For i = 2 To LastRow 'loop from row 2 to last
If ws.Cells(i, FoundStart.Column) > 0 Then '
ws.Cells(i, FoundStart.Column).Interior.ColorIndex = 6
End If
Next i
End If
Set FoundStart = ws.Rows(1).Find(What:="Disk Limit")
If Not FoundStart Is Nothing Then 'if both headers are found then
For i = 2 To LastRow 'loop from row 2 to last
If ws.Cells(i, FoundStart.Column) > -1 Then '
ws.Cells(i, FoundStart.Column).Interior.ColorIndex = 6
End If
Next i
End If
Set FoundStart = ws.Rows(1).Find(What:="Level (MEM)")
If Not FoundStart Is Nothing Then 'if both headers are found then
For i = 2 To LastRow 'loop from row 2 to last
If ws.Cells(i, FoundStart.Column) <> "normal" Then '
ws.Cells(i, FoundStart.Column).Interior.ColorIndex = 6
End If
Next i
End If
Set FoundStart = ws.Rows(1).Find(What:="Level (CPU)")
If Not FoundStart Is Nothing Then 'if both headers are found then
For i = 2 To LastRow 'loop from row 2 to last
If ws.Cells(i, FoundStart.Column) <> "normal" Then '
ws.Cells(i, FoundStart.Column).Interior.ColorIndex = 6
End If
Next i
End If
Set FoundStart = ws.Rows(1).Find(What:="Tools")
If Not FoundStart Is Nothing Then 'if both headers are found then
For i = 2 To LastRow 'loop from row 2 to last
If ws.Cells(i, FoundStart.Column) <> "toolsOk" Then '
ws.Cells(i, FoundStart.Column).Interior.ColorIndex = 6
End If
Next i
End If
Set FoundStart = ws.Rows(1).Find(What:="Upgrade Policy")
If Not FoundStart Is Nothing Then 'if both headers are found then
For i = 2 To LastRow 'loop from row 2 to last
If ws.Cells(i, FoundStart.Column) <> "upgradeAtPowerCycle" Then '
ws.Cells(i, FoundStart.Column).Interior.ColorIndex = 6
End If
Next i
End If
Set FoundStart = ws.Rows(1).Find(What:="Shared (MB)")
If Not FoundStart Is Nothing Then 'if both headers are found then
For i = 2 To LastRow 'loop from row 2 to last
If ws.Cells(i, FoundStart.Column) > 0 Then '
ws.Cells(i, FoundStart.Column).Interior.ColorIndex = 6
End If
Next i
End If
End subExample output below: (The values are made up, but I would like them to be the counted result from the VBA code.
| # VMs with CPU Reservations | # VMs with CPU limits | # VMs with CPU Hot Add | # VMs with Memory Swapping |
| 45 | 70 | 36 | 9 |
