Insert cell .Address as string into Range() ?

Question

I have a piece of code that should loop through each cell in a Range. Under certain conditions those cell Addresses (e.g., "E8") should be added to an array, and each cell in that range should be changed to the "Good" style.

However when I run this, I get the error:

Run-time error '1004':

Method 'Style' of object 'Range' failed

Here is my code:

Dim cell As Range

Dim cellArray() As Variant

For Each cell In Range("A8:H8")

   If (IsEmpty(cell.Value)) And (cell.Style <> "Bad") Then

      ReDim cellArray(cell + 1)

      cellArray(cell) = cell.Address(False, False)

      Range(cell.Address(False, False)).Style = "Good"

   End If

Next cell

If I try to print Range(cell.Address(False, False)) to a MsgBox, it comes back blank. I also tried assigning Range(cell.Address(False, False)) to a variable "r" which I dimensioned as both a String and a Range, but both times there were other errors.

Any help appreciated.

Answer 1

Try the following code.

When you ReDim an array, you destroy all previous data in the array.

If you want to resize the array without losing the existing data then use ReDim Preserve.

To use ReDim Preserve, the array must have at least one element. Therefore ReDim the array with one element before commencing the loop. The element will be blank until data is assigned to it.

You will see in the example where I ReDimmed and created one element before the loop and then used ReDim Preserve to create another element each time a value needs to be added. The interesting thing here is that the first time Redim Preserve is used, it does not add another element because you can use the command with the same initial values that were initially used to create one element and it will not add another element.

The variable J is used and initialized to one. It is then used to ReDim to create the first element and then it is still one when the First ReDim Preserve is used but after that it is incremented  for the next ReDim Preserve.

I have added a MsgBox test to view the results.

Sub PopulateDynamicArray()

    Dim cell As Range

    Dim cellArray() As Variant

    Dim i As Long

    Dim j As Long

    j = 1

    'Following creates a One based array

    ReDim cellArray(1 To j) 'Initialize to one element otherwise Redim Preserve does not work

    For Each cell In Range("A8:H8")

        If (IsEmpty(cell.Value)) And (cell.Style <> "Bad") Then

            ReDim Preserve cellArray(1 To j)  'Does not change array size on first iteration

            cellArray(j) = cell.Address(False, False)

            j = j + 1

            Range(cell.Address(False, False)).Style = "Good"

        End If

    Next cell

    'Following code to test the array.

    For i = LBound(cellArray) To UBound(cellArray)

        MsgBox cellArray(i)

    Next i

End Sub

Answer 2

Using cell.Style was actually the first thing I did before I tried the code I posted but I thought I might have to more explicitly make it a Range to work, since it didn't before. That still returns the error unfortunately.

Run-time error '1004':

Method 'Style' of object 'Range' failed

I have cell dimensioned as Range also. So I'm not sure what the problem is. It won't run anything with the 'Here' variable because it throws the error on cell.Style.

Answer 3

This leads me to believe that it might not be possible to pass a dynamic variable to Range ?

No, you just make it unnecessarily complicated. Use the objects and it becomes easy, see example code below.

Andreas.

Sub Test()

  Dim Here As Range, Cell As Range

  For Each Cell In Range("A8:H8")

    'Check the cell (with any condition you like)

    If (IsEmpty(Cell.Value)) And (Cell.Style <> "Bad") Then

      'Cell.Style = "Good" 'Makes that sense?

      'Combine if the check failed

      If Here Is Nothing Then

        Set Here = Cell

      Else

        Set Here = Union(Here, Cell)

      End If

    End If

  Next

  'Found any cells that met the condition?

  If Not Here Is Nothing Then

    MsgBox "All cells must have a value to continue. Please enter a value for " & Here.Address(0, 0)

    Exit Sub

  End If

  MsgBox "Success"

End Sub

Answer 4

Thanks for your response! It looks like that worked!

EDIT:

Ah, actually sorry I thought this thread was for a different question I had asked.

This did not work. It's still throwing the run-time error.

But, when removing 

Range(cell.Address(False, False)).Style = "Good"

It works.

This leads me to believe that it might not be possible to pass a dynamic variable to Range ? Logically it's a little confusing because there will be cases where the array should actually equal 0, if the user enters values in all of the cells. Since my logic checks for the length of the array before displaying the MsgBox I'm not sure if that will help me. This is the code I tried with the run time error again:

    Dim cellArray() As Variant

    Dim j As Long

    j = 1

    ReDim cellArray(1 To j)

        For Each cell In Range("A8:H8")

            If (IsEmpty(cell.Value)) And (cell.Style <> "Bad") Then

                ReDim Preserve cellArray(1 To j)

                cellArray(j) = cell.Address(False, False)

                j = j + 1

                Range(cell.Address(False, False)).Style = "Good"

            End If

        Next cell

        If Len(Join(cellArray)) > 0 Then

            MsgBox "All cells must have a value to continue. Please enter a value for " & Join(cellArray, ", ")

        Else

           ' Do something else

However this answer did help answer my other question (which you also answered):

https://answers.microsoft.com/en-us/msoffice/forum/msoffice_excel-msoffice_custom-mso_2016/code-only-prints-last-item-in-array-in-msgbox/9371818d-b0f5-4528-918e-0f9b27b8b17b