# Converting from Ranges to Arrays to do calculations

#### JeffGrant

##### Board Regular
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

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

#### Akuini

##### Well-known Member
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

#### JeffGrant

##### Board Regular
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 ?

#### Akuini

##### Well-known Member
No, I'm not a professional Excel programmer, Excel vba is just one of my hobbies.

#### JeffGrant

##### Board Regular

No, I'm not a professional Excel programmer, Excel vba is just one of my hobbies.
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``````

the d(x) part is throwing me

your code is so fast..I am gob smacked

Last edited:

#### Akuini

##### Well-known Member
Why not use Conditional Formatting? It's easier.

#### JeffGrant

##### Board Regular

Because on this particular sheet, the sheet is completely erased and PQ brings in new data every day. All formulas a written out everyday

#### JeffGrant

##### Board Regular
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

#### Akuini

##### Well-known Member
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()

#### JeffGrant

##### Board Regular
Thanks..that works....

Replies
0
Views
48
Replies
3
Views
253
Replies
7
Views
142
Replies
0
Views
99
Replies
40
Views
2K

1,147,560
Messages
5,741,825
Members
423,689
Latest member
Jords998

### 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.

### Which adblocker are you using?

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

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