VBA: Search, locate and Summarize

From what I see I would personally use and additional (hidden if preferred) column to vlookup the type from the other sheet and bring it into each row. You can then use countif in your seperate table to count the number of each. If you want the table with the counts in them to be dynamic too then you could either use advanced filter to generate it (my preference as a bear of small brain I find it easier to maintain) or more sexily you can probably create a funky formula to do this.

http://www.mrexcel.com/board2/viewtopic.php?t=104158&highlight=select+unique+values

Yes, I have a solution with lookup, count-if etc.

I am trying VBA as I wish to avoid copying the formula into new cells, as the data in the inventory grows.

Also as my sheet is distributed to many users, I thought macro solution will be cool.


Thanks

I am prefering VBA as I have more than 600 types that are to be summarised.

But my working file may have any of the 600 types

My approach (ask a lazy man) would be to create a sub to automate the extract of unique values via advanced filter, then under VBA control move down and insert the required countif function. In the below example I am assuming you have generated output from an advanced filter and the output data starts in B7


Dim i

YourRange = "A1:a10"

i = 7

While Cells(i, 2) <> ""

Cells(i, 3).Formula = "=countif(" & YourRange & ", " & Cells(i, 10).Address(False, False) & ")"
i = i + 1
Wend


There arwe various options as to how you contstruct/obtain MyRange ()which should be your data block) if you need help with this just let us know.

Hi,

You already been using one formula for the Sno. So why not use a vlookup for Types?

Kris

Hello,

Based off of your first sheet example (as I'm lost to what the second one was) maybe you could use something like this ...


<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> SummarizeMyData()
    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>
    Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN>
    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> tmpWs <SPAN style="color:#00007F">As</SPAN> Worksheet, origWs <SPAN style="color:#00007F">As</SPAN> Worksheet, rngDescp <SPAN style="color:#00007F">As</SPAN> Range
    <SPAN style="color:#00007F">Dim</SPAN> rngTmp <SPAN style="color:#00007F">As</SPAN> Range
    <SPAN style="color:#00007F">Dim</SPAN> cel <SPAN style="color:#00007F">As</SPAN> Range, rng <SPAN style="color:#00007F">As</SPAN> Range, wf, fSpace <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> origWs = ActiveSheet
    origWs.Range("E:F").ClearContents
    <SPAN style="color:#00007F">Set</SPAN> wf = Application.WorksheetFunction
    <SPAN style="color:#00007F">Set</SPAN> rngDescp = origWs.Range("B1:B" & origWs.Range("B65536").End(xlUp).Row)
    <SPAN style="color:#00007F">Set</SPAN> tmpWs = Worksheets.Add
    rngDescp.AdvancedFilter action:=xlFilterCopy, _
        copytorange:=tmpWs.Range("A1"), unique:=<SPAN style="color:#00007F">True</SPAN>
    <SPAN style="color:#00007F">If</SPAN> Err <> 0 <SPAN style="color:#00007F">Then</SPAN>
        MsgBox "There was a problem with your ranges!", vbInformation, "ERROR"
        Err.Clear
        <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> rng = tmpWs.Range("A2:A" & tmpWs.Range("A65536").End(xlUp).Row)
    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> cel <SPAN style="color:#00007F">In</SPAN> rng
        <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> Len(cel.Value) <SPAN style="color:#00007F">Step</SPAN> 1
            <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> Mid(cel.Value, i, 1)
            <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> = " ", Chr(32), Chr(160)
                fSpace = i
                <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">For</SPAN>
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
        <SPAN style="color:#00007F">Next</SPAN> i
        <SPAN style="color:#00007F">If</SPAN> fSpace <> 0 <SPAN style="color:#00007F">Then</SPAN>
            cel.Value = Trim(Left(cel.Value, fSpace))
        <SPAN style="color:#00007F">Else</SPAN> <SPAN style="color:#007F00">'No space, leave alone</SPAN>
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">Next</SPAN> cel
    <SPAN style="color:#00007F">Set</SPAN> rngTmp = tmpWs.Range("A1:A" & tmpWs.Range("A65536").End(xlUp).Row)
    rngTmp.AdvancedFilter action:=xlFilterCopy, _
        copytorange:=tmpWs.Range("B1"), unique:=<SPAN style="color:#00007F">True</SPAN>
    <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> tmpWs.Range("B65536").End(xlUp).Row <SPAN style="color:#00007F">Step</SPAN> 1
        origWs.Range("E" & i).Value = tmpWs.Range("B" & i).Value
        <SPAN style="color:#00007F">If</SPAN> i <> 1 <SPAN style="color:#00007F">Then</SPAN>
            origWs.Range("F" & i).Formula = "=COUNTIF(B:B,E" & i & "&""*"")"
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">Next</SPAN> i
    tmpWs.Delete
    Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN>
    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>
    MsgBox "Complete!"
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>



Caveat: It assumes that you will only be using the first word in column B and discard the data after the first space (if one) to count with.


HTH