Converting from Ranges to Arrays to do calculations

JeffGrant

Well-known Member
Joined
Apr 7, 2021
Messages
510
Office Version
  1. 365
Platform
  1. Windows
Hi All,

I am relatively new to arrays and find this a bit confusing.

I have a table, starting in cell A2, variable depth, but with constant width of 62 columns wide.

From Column N (col 14), I create a list of unique values in Column BL (col 64) -> all good

The idea is to count each incidence in Column N of the unique value in Column BL and output the count result to Column BM (col 54) -> all good, but slow.........

Enter Arrays..... because I am trying to loop one array (unique values), inside another (the raw data), I cant seem to get the syntax right. I am probably doing something most silly...

This is the basic code with all the extra bits removed.

Would somebody, please be so kind as to add the extra bits to turn this into an array sub, so I can compare it against my fruitless efforts. :)


VBA Code:
Sub DualAcceptanceTest()

    Dim rngData As Range, rngUniqueData As Range
    Dim lngRow As Long, RowCount As Long, lngCount As Long

    'Select active sheet
    Sheet5.Select 'Input Import
   
    'Set up Data to search
    Set rngData = Range("N3", Range("N3").End(xlDown))
     
    'Set up Unique values to look for
    RowCount = Range("N4").End(xlDown).Row
    Range("BL3").Formula2 = "=unique(N3:N" & RowCount & ")"
    Set rngUniqueData = Range("BL3", Range("BL3").End(xlDown))
   
    With rngUniqueData
       
        For lngRow = 1 To .Rows.Count
                   
            lngCount = Application.WorksheetFunction.CountIf(rngData, .Cells(lngRow, 1).Value)
            .Cells(lngRow, 2).Value = lngCount
            
            If lngCount > 3 Then
                .Cells(lngRow, 2).Interior.ColorIndex = 6
            End If
        
        Next lngRow
    End With

End Sub
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
I usually use dictionary object to get count of unique values.
Like this:
VBA Code:
Sub toCountUnique()
Dim va
Dim d As Object

'va = Range("A2", Cells(Rows.Count, "A").End(xlUp))
va = Range("A2", Range("A2").End(xlDown))

Set d = CreateObject("scripting.dictionary")
d.CompareMode = vbTextCompare

For Each x In va
    d(x) = d(x) + 1
Next

Range("C2").Resize(d.Count, 2) = Application.Transpose(Array(d.Keys, d.Items))

End Sub

Book1
ABCD
1data
2CC2
3UU3
4FF3
5UJ2
6UT2
7FH1
8FM1
9J
10T
11H
12C
13J
14T
15M
Sheet1
 
Upvote 0
Solution
Hi Akuini,

blimmy charlie...your knowledge is GOLD man.....

this works like a treat...don't even have time to blink....

are you a professional Excel programmer ?
 
Upvote 0
Glad it works. (y)
No, I'm not a professional Excel programmer, Excel vba is just one of my hobbies.:biggrin:
 
Upvote 0
Glad it works. (y)
No, I'm not a professional Excel programmer, Excel vba is just one of my hobbies.:biggrin:
Hi Buddy, I have this little bit that adds some highlight to the cell easy for identification.

VBA Code:
            If lngCount > 3 Then
                .Cells(lngRow, 2).Interior.ColorIndex = 6
            End If

How do I add this to your code.....where I think my lngCount= your d.Count

the d(x) part is throwing me

your code is so fast..I am gob smacked
 
Last edited:
Upvote 0
Why not use Conditional Formatting? It's easier.
JeffGrant.jpg
 
Upvote 0
Because on this particular sheet, the sheet is completely erased and PQ brings in new data every day. All formulas a written out everyday
 
Upvote 0
Can I add conditional formatting with VB in this loop, before the data is written out to the sheet=

For Each x In va
d(x) = d(x) + 1
Next
 
Upvote 0
You can use macro recorder to get the macro to set up the conditional formatting. Then move the macro to your code module where sub DualAcceptanceTest() is located .
Then you can call the macro (say Macro1) on your sub. You can call it before or after the data is written out to the sheet.
Something like this:

VBA Code:
Call Macro1
Range("C2").Resize(d.Count, 2) = Application.Transpose(Array(d.Keys, d.Items))

OR

Just run Macro1 then run your sub DualAcceptanceTest()
 
Upvote 0

Forum statistics

Threads
1,213,496
Messages
6,113,995
Members
448,539
Latest member
alex78

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
Back
Top