VBA Code to Count if value is >, <,= or <> in a certain column and add result to a summary worksheet

radeon187

New Member
Joined
Mar 25, 2020
Messages
28
Office Version
  1. 365
Platform
  1. Windows
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:
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 sub

Example 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
4570369
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

radeon187

New Member
Joined
Mar 25, 2020
Messages
28
Office Version
  1. 365
Platform
  1. Windows
Any ideas would be greatly appreciated!
 

Watch MrExcel Video

Forum statistics

Threads
1,129,367
Messages
5,635,853
Members
416,886
Latest member
coreyalaurence37

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top