Array Range and IsEmpty If Then Statement VBA. Ove

Question

I'm brand new to VBA. Got about 4 weeks under my belt so far. And this is the last portion of a long list of macros for completing data cleanup and analysis for a report. Maybe this isn't the best way to do this? I'm still new to this, so I'm open to other suggestions. But it needs to be a macro. This is basically what it looks like (the highlighted fields are filled with a vlookup, which is why I have two different arrays because they're not contiguous):

link to snip of the worksheet

The number of rows varies depending on the report. Sometimes its 4000 rows, sometimes its more, sometimes its less. But I've made sure that every column would be the same. We're trying to automate as much of it as we can so that we might be able to get some less-technical people to be able to run through the entire process. The first time I went through the process it took me 6 hours (although I was taking notes too). For the senior person here it takes about 2 hours for each one, depending. We have somewhere around 300 of these to do before the end of the year.

Anyways, this code works, but it overwrites all of my iferror/vlookup results that I inserted. I'm guessing my 'For Each If Then' statement is to blame. But I've been working on this for a couple days, trying different ways to achieve this goal and this is closest that I've gotten. Any help would be greatly appreciated. I'm sure its something super simple...

Sub AutomateAllTheThings6()
Dim arr3() As String
Dim arr11() As String
Dim rng3 As Range
Dim rng11 As Range
Dim sourcerng As Range
Dim lastRow As Long
    Call OptimizeCode_Begin
        lastRow = Range("D1:D" & Range("D1").End(xlDown).Row).Rows.Count
        Set rng3 = ActiveSheet.Range("BH2:BJ2" & ":BH" & lastRow)
        Set rng11 = ActiveSheet.Range("BL2:BV2" & ":BL" & lastRow)
        Set sourcerng = ActiveSheet.Range("BE2:BF2" & ":BE" & lastRow)
        arr3() = Split("UNKNOWN,UNKNOWN,UNKNOWN", ",")
        arr11() = Split("UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, 00/00/0000, 00/00/0000, 00/00/0000, 00/00/0000, NEEDS REVIEW", ",")
            For Each cell In sourcerng
                If IsEmpty(cell) Then
                    rng3.Value = arr3
                    rng11.Value = arr11
                End If
            Next
    Call OptimizeCode_End
End Sub

Answer 1

You can also use such version with arrays. Although in my code results are not pasted into arrays, the computing is done based on them, what makes code execute much faster than when operating on cells in range.

Option Explicit
Option Base 1

Sub AutomateAllTheThings6()

Dim arr3() As String, arr11() As String
Dim rng3 As Range, rng11 As Range, sourceRng As Range
Dim vSource As Variant
Dim nCounter1 As Long, nCounter2 As Long, lastRow As Long

    Call OptimizeCode_Begin

    Const firstRow As Long = 2

    With ActiveSheet
        lastRow = .Range("D1:D" & Range("D1").End(xlDown).Row).Rows.Count
        Set rng3 = .Range("BH" & firstRow & ":BJ" & lastRow)
        Set rng11 = .Range("BL" & firstRow & ":BV" & lastRow)
        Set sourceRng = .Range("BE" & firstRow & ":BF" & lastRow)
    End With

    vSource = sourceRng

    arr3() = Split("UNKNOWN,UNKNOWN,UNKNOWN", ",")
    arr11() = Split("UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, 00/00/0000, 00/00/0000, 00/00/0000, 00/00/0000, NEEDS REVIEW", ",")

    For nCounter1 = LBound(vSource) To UBound(vSource) 'loop through all rows in source range
        For nCounter2 = LBound(vSource, 2) To UBound(vSource, 2) 'loop through all columns in the row
            If IsEmpty(vSource(nCounter1, nCounter2)) Then 'if cell is empty
                rng3.Rows(nCounter1) = arr3
                rng11.Rows(nCounter1) = arr11
                Exit For
            End If
        Next nCounter2
    Next nCounter1

   Call OptimizeCode_End

End Sub

Answer 2

You are refering to the whole range with:

rng3.Value = arr3

So when any are found blank the whole range gets set, not just that row. We can do just that row by using Intersect

Intersect(rng3, ActiveSheet.Rows(cell.Row)).Value = arr3

Also, Your ranges are in error

Set rng3 = ActiveSheet.Range("BH2:BJ2" & ":BH" & lastRow)

would refer to range BH2:BJ2:BH100

Cahnge to:

Set rng3 = ActiveSheet.Range("BH2:BJ" & lastRow)

so:

Sub AutomateAllTheThings6()
Dim arr3() As String
Dim arr11() As String
Dim rng3 As Range
Dim rng11 As Range
Dim sourcerng As Range
Dim lastRow As Long
    Call OptimizeCode_Begin
        lastRow = ActiveSheet.Range("D1").End(xlDown).Row
        Set rng3 = ActiveSheet.Range("BH2:BJ" & lastRow)
        Set rng11 = ActiveSheet.Range("BL2:BV" & lastRow)
        Set sourcerng = ActiveSheet.Range("BE2:BF" & lastRow)
        arr3() = Split("UNKNOWN,UNKNOWN,UNKNOWN", ",")
        arr11() = Split("UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, 00/00/0000, 00/00/0000, 00/00/0000, 00/00/0000, NEEDS REVIEW", ",")
            For Each cell In sourcerng
                If IsEmpty(cell) Then
                    Intersect(rng3, ActiveSheet.Rows(cell.Row)).Value = arr3
                    Intersect(rng11, ActiveSheet.Rows(cell.Row)).Value = arr11
                End If
            Next
    Call OptimizeCode_End
End Sub