Count occurrences for unknown values

cadlum · May 17, 2013

So i have a list of laptops spanning multiple worksheets. I have code that will go through and look for how many of each type of laptop there is. Right now, the code is static and will only search for the types of laptops i tell it to (hard coded into vba). This code works great. But now I am wanting to improve upon it.

For my improvements, I would like to have the code be able to look at the types columns, find new types, search the whole workbook for the type, and count how many it finds, then repeat for a new type.

I assume this is possible but it is a bit out of my skill level right now.

Thanks in advance for the help!

My current code:

Code:

Sub compTypes()


'Declaring variables
Dim wb2 As Workbook, sh As Worksheet, NewSh As Worksheet, i As Long
Dim E4300 As Integer, E4310 As Integer, E6320 As Integer, E6400 As Integer, E6410 As Integer
Dim E6420 As Integer, E6430 As Integer, O780 As Integer, O790 As Integer, O7010 As Integer
Dim FilePath As String, FileName1 As String


'Checks to make sure the file and path are loaded
If IsEmpty(Range("G1").Value) Or IsEmpty(Range("G2").Value) Then
    Call updateFileLocations.UpdateFileLoc
End If


'Read in file name and location into variables
FileName1 = Range("G1").Value
FilePath = Range("G2").Value


'Open inventory list sheet
Workbooks.Open FileName:=FilePath & FileName1


'Create a new temp sheet and setting inventory lists to variables
Set wb2 = Workbooks(FileName1)
Set NewSh = ThisWorkbook.Sheets.Add(After:=Sheets(ThisWorkbook.Sheets.Count))


'Labelling new temp sheet
NewSh.Name = "Computer Types"


'Labelling cells for table format
With NewSh
    .Range("A1") = "Computer Type"
    .Range("B1") = "Amount"
    .Range("A2") = "Dell Latitude E4300"
    .Range("A3") = "Dell Latitude E4310"
    .Range("A4") = "Dell Latitude E6320"
    .Range("A5") = "Dell Latitude E6400"
    .Range("A6") = "Dell Latitude E6410"
    .Range("A7") = "Dell Latitude E6420"
    .Range("A8") = "Dell Latitude E6430"
    .Range("A9") = "Dell Optiplex 780"
    .Range("A10") = "Dell Optiplex 790"
    .Range("A11") = "Dell Optiplex 7010"
    .Range("A13") = "Total Deployed"
End With


'Creating array of workbooks being used
wb = Array(wb2)


'A loop that counts how many different types of machines exist
For i = LBound(wb) To UBound(wb)
    For Each sh In wb(i).Sheets
        If Application.CountA(sh.Range("G4:G103")) > 0 Then
            E4300 = E4300 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "4300")
            E4310 = E4310 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "4310")
            E6320 = E6320 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "6320")
            E6400 = E6400 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "6400")
            E6410 = E6410 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "6410")
            E6420 = E6420 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "6420")
            E6430 = E6430 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "6430")
            O780 = O780 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "780")
            O790 = O790 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "790")
            O7010 = O7010 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "7010")
            'Adds current count of each variable to temp sheet
            With NewSh
                .Range("B2") = E4300
                .Range("B3") = E4310
                .Range("B4") = E6320
                .Range("B5") = E6400
                .Range("B6") = E6410
                .Range("B7") = E6420
                .Range("B8") = E6430
                .Range("B9") = O780
                .Range("B10") = O790
                .Range("B11") = O7010
            End With
        End If
    Next
Next


'Creating temp sheet's own workbook and formatting the sheet
ThisWorkbook.Sheets("Computer Types").Copy
ActiveSheet.Columns.AutoFit
ActiveSheet.Range("B13").Select
'Add a formula at the end to do a total of all machines
ActiveCell.FormulaR1C1 = "=SUM(R[-11]C:R[-2]C)"
ActiveSheet.Range("A14").Select


'Saving new workbook and deleting temp
ActiveWorkbook.SaveAs FilePath & "\Reports\Computer Types " & Format(Date, "mmm-yyyy") & ".xlsx"
Application.DisplayAlerts = False
ThisWorkbook.Sheets("Computer Types").Delete
Application.DisplayAlerts = True


'Closing inventory list
Workbooks(FileName1).Close SaveChanges:=False
End Sub

sijpie · May 21, 2013

OK, first of all I notice that you declare most of, but not all of your variables. Such as wb is not declared before use. This could easily lead to errors as wb and wb2 are nearly equal in name but not in type. Make a habit of declaring all variables. Better still, go (in VBA editor) to Tools/Options and tcik the 'Require Variable Decleration' tickbox. Now VBA editor will start every new module with

Code:

Option Explicit

which tells it to check.

Olso in your for...next loops, put the variable behind next to make it clear for yourself what is looping:

Code:

for i = 1 to 100
    ...
next i

I would modify the count loop to read the G4:G103 range into an array, and then check each type and count in another array. below is a possible way of doing so. Doing this in an array rather than reading each cell in turn makes a huge speed difference

So now your code becomes:

Sub compTypes() 'Declaring variables Dim wb2 As Workbook, sh As Worksheet, NewSh As Worksheet, i As Long Dim E4300 As Integer, E4310 As Integer, E6320 As Integer, E6400 As Integer, E6410 As Integer Dim E6420 As Integer, E6430 As Integer, O780 As Integer, O790 As Integer, O7010 As Integer Dim FilePath As String, FileName1 As String 'Checks to make sure the file and path are loaded If IsEmpty(Range("G1").Value) Or IsEmpty(Range("G2").Value) Then Call updateFileLocations.UpdateFileLoc End If 'Read in file name and location into variables FileName1 = Range("G1").Value FilePath = Range("G2").Value 'Open inventory list sheet Workbooks.Open Filename:=FilePath & FileName1 'Create a new temp sheet and setting inventory lists to variables Set wb2 = Workbooks(FileName1) Set NewSh = ThisWorkbook.Sheets.Add(After:=Sheets(ThisWorkbook.Sheets.Count)) 'Labelling new temp sheet NewSh.Name = "Computer Types" 'Labelling cells for table format With NewSh .Range("A1") = "Computer Type" .Range("B1") = "Amount" .Range("A2") = "Dell Latitude E4300" .Range("A3") = "Dell Latitude E4310" .Range("A4") = "Dell Latitude E6320" .Range("A5") = "Dell Latitude E6400" .Range("A6") = "Dell Latitude E6410" .Range("A7") = "Dell Latitude E6420" .Range("A8") = "Dell Latitude E6430" .Range("A9") = "Dell Optiplex 780" .Range("A10") = "Dell Optiplex 790" .Range("A11") = "Dell Optiplex 7010" .Range("A13") = "Total Deployed" End With 'Creating array of workbooks being used wb = Array(wb2) Dim aTypes As Variant, aCount As Variant, bFound As Boolean Dim k As Integer, j As Integer ReDim aCount(1 To 2, 1 To 1) ' ... 'A loop that counts how many different types of machines exist For i = LBound(wb) To UBound(wb) For Each sh In wb(i).Sheets aTypes = Range("G4:G103") 'Put first type in array aCount(1, 1) = aTypes(1, 1) For k = LBound(aTypes) To UBound(aTypes) bFound = False If aTypes(k, 1) <> vbNullString Then For j = LBound(aCount, 2) To UBound(aCount, 2) If aCount(1, j) = aTypes(k, 1) Then aCount(2, j) = aCount(2, j) + 1 bFound = True Exit For End If Next j If bFound = False Then ' new type ' expand count array for new name, keep existing info ReDim Preserve aCount(1 To UBound(aCount, 1), 1 To UBound(aCount, 2) + 1) ' ReDim Preserve myArray(UBound(myArray, 1), UBound(myArray, 2) + 1) 'add new name to array and add one for score aCount(1, UBound(aCount, 2)) = aTypes(k, 1) aCount(2, UBound(aCount, 2)) = 1 End If End If Next k ' If Application.CountA(sh.Range("G4:G103")) > 0 Then ' E4300 = E4300 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "4300") ' E4310 = E4310 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "4310") ' E6320 = E6320 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "6320") ' E6400 = E6400 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "6400") ' E6410 = E6410 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "6410") ' E6420 = E6420 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "6420") ' E6430 = E6430 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "6430") ' O780 = O780 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "780") ' O790 = O790 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "790") ' O7010 = O7010 + Application.WorksheetFunction.CountIf(sh.Range("G4:G103"), "7010") ' 'Adds current count of each variable to temp sheet ' With NewSh ' .Range("B2") = E4300 ' .Range("B3") = E4310 ' .Range("B4") = E6320 ' .Range("B5") = E6400 ' .Range("B6") = E6410 ' .Range("B7") = E6420 ' .Range("B8") = E6430 ' .Range("B9") = O780 ' .Range("B10") = O790 ' .Range("B11") = O7010 ' End With ' End If Next sh Next i Range("B2").Resize(UBound(aCount, 2), 2).Value = Application.Transpose(aCount) 'In printing out the types and count in the line above, this is done on order _ of appearance, so you need to find a way to order your headings in column A _ in accordance. 'Creating temp sheet's own workbook and formatting the sheet ThisWorkbook.Sheets("Computer Types").Copy ActiveSheet.Columns.AutoFit ActiveSheet.Range("B13").Select 'Add a formula at the end to do a total of all machines ActiveCell.FormulaR1C1 = "=SUM(R[-11]C:R[-2]C)" ActiveSheet.Range("A14").Select 'Saving new workbook and deleting temp ActiveWorkbook.SaveAs FilePath & "\Reports\Computer Types " & Format(Date, "mmm-yyyy") & ".xlsx" Application.DisplayAlerts = False ThisWorkbook.Sheets("Computer Types").Delete Application.DisplayAlerts = True 'Closing inventory list Workbooks(FileName1).Close SaveChanges:=False End Sub

cadlum · May 21, 2013

Thank you for the code. I will start testing with it to let you know how it goes and if i have any questions. Also, sorry for the sloppiness of not declaring stuff properly. I try to do that as much as possible so thanks for the tip on the option explicit.

cadlum · May 24, 2013

Sorry for the delay. I finally got a chance to test the code. I am getting a blank worksheet (well the counts are blank). Since this code is a bit over my head, I am having trouble debugging it. Could you help describe what the code is doing or let me know where this might be failing? Thanks

sijpie · May 25, 2013

Can you post your spreadsheet on dropbox or similar? Just to get the columns etc 100% correct

cadlum · May 31, 2013

So i had a moment to play with the code a bit longer. I saw that the for loops are picking up on the different types of computers that I have. From the looks of it, everything in the for loops Is functioning properly. After all the for loops, you had the code of:

Code:

 Range("B2").Resize(UBound(aCount, 2), 2).Value = Application.Transpose(aCount)

I found that if I added 'NewSh.' to the beginning of it, it at least got some output on the correct sheet. Now the output I am getting isn't printing out properly. The B column comes up with only the first type it found. Then the C column comes up with some counts. The first row is a higher number and the rest of the rows are just 1. My thinking is that this line needs to be a for loop to be able to print things out properly, is that right?

For my files themselves, I can't upload them because of some privacy stuff, but here is the headers and a sample line:

A

B

C

D

E

F

G

H

I

J

K

L

M

N

SERVICE TAG

Shipped Date

Lease End

Warranty thru

Warranty Type

Type

Drive #

License

USER

VPN Expiration

DEPT

Windows

Other

XXXXXXX

5/31/2013

5/31/2016

Gold

6410

XX-XXX

1

First Last

5/31/2013

Business

Windows 7

Notes

Thanks again for all the help!

sijpie · Jun 3, 2013

I have tested the following code on a workbook with a few sheets structured according to your example and (after commenting out all the file opening and closing lines) it produces a table with the types and the counts.

Writing an array to a sheet is a one write operation, so no looping. That is why arrays are used so often: speed. Same as reading the PC list into the atypes array, only one read. Then the looping and comparing variables can be done on memory from the arrays.

Sub compTypes() 'Declaring variables Dim wb2 As Workbook, sh As Worksheet, NewSh As Worksheet Dim FilePath As String, FileName1 As String Dim aTypes As Variant, aCount As Variant, bFound As Boolean Dim k As Integer, j As Integer 'Checks to make sure the file and path are loaded If IsEmpty(Range("G1").Value) Or IsEmpty(Range("G2").Value) Then Call updateFileLocations.UpdateFileLoc End If 'Read in file name and location into variables FileName1 = Range("G1").Value FilePath = Range("G2").Value 'Open inventory list sheet Workbooks.Open Filename:=FilePath & FileName1 'Create a new temp sheet and setting inventory lists to variables Set wb2 = Workbooks(FileName1) Set NewSh = ThisWorkbook.Sheets.Add(After:=Sheets(ThisWorkbook.Sheets.Count)) ' Stop screen flikker, speed up macro Application.ScreenUpdating = False ' We set the counting array to take a first type. For each new type _ it will be expanded ReDim aCount(1 To 2, 1 To 1) 'A loop that counts how many different types of machines exist For Each sh In wb2.Sheets ' Load the list of PCs into an array aTypes = sh.Range("G4:G103") 'Put first type in array If aCount(1, 1) = vbNullString Then aCount(1, 1) = aTypes(1, 1) For k = LBound(aTypes) To UBound(aTypes) bFound = False If aTypes(k, 1) <> vbNullString Then For j = LBound(aCount, 2) To UBound(aCount, 2) If aCount(1, j) = aTypes(k, 1) Then aCount(2, j) = aCount(2, j) + 1 bFound = True Exit For End If Next j If bFound = False Then ' new type ' expand count array for new name, keep existing info ReDim Preserve aCount(1 To UBound(aCount, 1), 1 To UBound(aCount, 2) + 1) 'add new name to array and add one for score aCount(1, UBound(aCount, 2)) = aTypes(k, 1) aCount(2, UBound(aCount, 2)) = 1 End If End If Next k Next sh With NewSh 'Labelling new temp sheet .Name = "Computer Types" 'Labelling cells for table format .Range("A1") = "Computer Type" .Range("B1") = "Amount" .Cells(UBound(aCount, 2) + 3, 1) = "Total Deployed" ' Add PC names and counts .Range("A2").Resize(UBound(aCount, 2), 2).Value = Application.Transpose(aCount) 'Add a formula at the end to do a total of all machines .Cells(UBound(aCount, 2) + 3, 2).FormulaR1C1 = "=SUM(R[-" & UBound(aCount, 2) + 2 & "]C:R[-2]C)" .Columns.AutoFit End With 'In printing out the types and count in the line above, this is done on order _ of appearance, so you need to find a way to order your headings in column A _ in accordance. 'Creating temp sheet's own workbook wb2.Sheets("Computer Types").Copy 'Saving new workbook and deleting temp ActiveWorkbook.SaveAs FilePath & "\Reports\Computer Types " & Format(Date, "mmm-yyyy") & ".xlsx" With Application .DisplayAlerts = False wb2.Sheets("Computer Types").Delete .DisplayAlerts = True .ScreenUpdating = True End With 'Closing inventory list Workbooks(FileName1).Close SaveChanges:=False ' Clean up resources Set sh = Nothing Set wb2 = Nothing Set NewSh = Nothing End Sub

cadlum · Jun 5, 2013

code works great. Thanks!

cadlum · Jun 7, 2013

In case people come across this code and might want this...

Here is some code to glamour up the output a little. This will resize the columns, label them, add a sum at the bottom, and then sort them (I added the sort).

Code:

UBaCount2 = UBound(aCount, 2)

With NewSh
    'Labelling new temp sheet
    .Name = "Computer Types"
    'Labelling cells for table format
    .Range("A1") = "Computer Type"
    .Range("B1") = "Amount"
    .Cells(UBaCount2 + 3, 1) = "Total Deployed"
    'Add PC names and counts
    .Range("A2").Resize(UBaCount2, 2).Value = Application.Transpose(aCount)
    'Add a formula at the end to do a total of all machines
    .Cells(UBaCount2 + 3, 2).FormulaR1C1 = "=SUM(R[-" & UBaCount2 + 2 & "]C:R[-2]C)"
    .Columns.AutoFit
End With
With NewSh.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range("A2:A" & UBaCount2 + 1), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange Range("A1:B" & UBaCount2 + 1)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Count occurrences for unknown values

cadlum

New Member

Excel Facts

sijpie

Well-known Member

cadlum

New Member

cadlum

New Member

sijpie

Well-known Member

cadlum

New Member

sijpie

Well-known Member

cadlum

New Member

cadlum

New Member

Similar threads

Forum statistics

Share this page

Count occurrences for unknown values

New Member

Excel Facts

Well-known Member

New Member

New Member

Well-known Member

New Member

Well-known Member

New Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock