Copy Bolded Cells to an Array

[mgoose288]

Hi.
This seems like a simple thing but it is giving me problems
I would like to copy all of the bolded cells in a range that are not 0 into an array.
This is what I have right now.


Dim NOC(1 To 70)
Range("N2:AA:25).Select
Dim iCell As Range
k = 1
For Each iCell In Selection
if iCell.Font.Bold = True Then
NOC(k) = iCell.value
k = k + 1
End If
Next
Range("G1:G70").Value = NOC

However when I do this it just places the first bolded value into the array over and over again.

Hope someone can help

 

[MrKowz]

Welcome to the forums!

That shouldn't have even compiled, since your Select line had some syntax errors. Try this:

Public Sub mgoose()
Dim NOC(1 To 70)
Dim rng As Range
Set rng = Range("N2:AA25")
Dim iCell As Range
k = 1
For Each iCell In rng
    If iCell.Font.Bold = True Then
        NOC(k) = iCell.Value
        k = k + 1
    End If
Next iCell
Range("G1:G70").Value = NOC
End Sub

 

[mirabeau]

Try the following change to your code. As pointed out, others may be needed.

Dim NOC(1 To 70)
Range("N2:AA:25).Select
Dim iCell As Range
k = 1
For Each iCell In Selection
if iCell.Font.Bold = True Then
    NOC(k) = iCell.value
    k = k + 1
End If
Next
Range("G1:G70").Value = Application.Transpose(NOC)

 

[mgoose288]

Thanks!!
It was the transpose that fixed it.