Automate macro when specified cell range is blank - excel

Question

Been working/researching on this code I am developing for my workplace tasking sheet. First part calls for the 'movebasedonvalue' macro when column F indicates task is closed. Second part, what my goal is to reassign a new UID with the macro 'NewUID', which as a stand alone works; I am attempting to have it called as soon as a cell in specified range within column B is blank.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Z As Long
Dim xVal As String
On Error Resume Next
If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub
Application.EnableEvents = False
For Z = 1 To Target.Count
If Target(Z).Value > 0 Then
Call movebasedonvalue 'Macro to select row and move row content to specified sheet
End If
Next
Application.EnableEvents = True
End Sub
Private Sub FillBlanks(ByVal Target As Range)
Dim rngBlanks As Range
Dim ws As Worksheet
Set rngBlanks = Range("B4:B8,B10:B14,B16:20") 'Specifying the range
Set ws = ThisWorkbook.Worksheets("Burnout_Chart") 'Specifing Worksheet
With ws
If WorksheetFunction.CountBlank(rngBlank) > 0 Then 'wanting to identify blank cells in specified range
For Each area In rngBlanks.SpecialCells(xlCellTypeBlanks).Areas 'Trying to
Call NewUID 'Inputs new Unique ID into blank cell of Column B
Next
End If
End With
End Sub
Here is my movebasedonvalue code:
Sub movebasedonvalue()
Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim C As Long
A = Worksheets("Burnout_Chart").UsedRange.Rows.Count
B = Worksheets("Completed").usedRange.Rows.Count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Completed").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("Burnout_Chart").Range("F4:F" & A)
On Error Resume Next
Application.ScreenUdating = False
For C = 1 To xRg.Count
If CStr(xRg(C).Value) = "Closed" Then
xRg(C).EntireRow.Copy Destination:=Worksheets("Completed").Range("A" & B + 1)
xRg(C).EntireRow.ClearContents
If CStr(xRg(C).Value) = "Closed" Then
C = C - 1
End If
B = B + 1
End If
Next
Application.ScreenUpdating = True
End Sub
Here is my NewUID code:
Sub NewUID(c As Range)
Dim AR As Long
Dim MaxID As Long
Dim NewID As Long
Dim Burnout As Worksheet
Dim UID As Range
Set Burnout = ThisWorkbook.Sheets("Burnout_Chart")
Set UID = Range("B4:B8,B10:B14,B16:B20")
MaxID = Application.WorksheetFunction.Max(UID)
NewID = MaxID + 1
AR = ActiveCell.Row
ActiveCell.Value = NewID 'code to add id to cell c
End Sub

Answer 1

EDIT3: my last guess
Something like this should work
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range, rngUID As Range, nextID, nextRow As Long
Dim wsComp As Worksheet
On Error GoTo haveError
Set rng = Intersect(Target, Me.Range("F:F"))
If Not rng Is Nothing Then
Set wsComp = ThisWorkbook.Worksheets("Completed")
nextRow = NextEmptyRow(wsComp)
Application.EnableEvents = False
For Each c In rng.Cells
If c.Value = "Closed" Then
With c.EntireRow
.Copy wsComp.Cells(nextRow, "A")
.ClearContents
nextRow = nextRow + 1
End With
End If
Next c
Application.EnableEvents = True
End If
Set rngUID = Me.Range("B4:B8,B10:B14,B16:B20")
Set rng = Intersect(Target, rngUID)
If Not rng Is Nothing Then
nextID = Application.Max(rngUID) + 1 'next ID
Application.EnableEvents = False
For Each c In rng.Cells
If Len(c.Value) = 0 Then 'if cell is blank then assign an ID
c.Value = nextID
nextID = nextID + 1
End If
Next c
Application.EnableEvents = True
End If
Exit Sub
haveError:
Application.EnableEvents = True 'make sure events are re-enabled
End Sub
'given a worksheet, return the row number of the next empty row
Function NextEmptyRow(ws As Worksheet) As Long
Dim f As Range
Set f = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If f Is Nothing Then
NextEmptyRow = 1
Else
NextEmptyRow = f.Row + 1
End If
End Function

Answer 2

I figured out my issue, there's a lot that needs to be cleaned up but here is the code I got working for what I need:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Z As Long
Dim xVal As String
Dim KeyCells As Range 'redundant (Choose one or the other)
Dim UID As Range 'redundant (Choose one or the other)
Dim AR As Long
Dim MaxID As Long
Dim NewID As Long
Dim Burnout As Worksheet
On Error Resume Next
Set KeyCells = Range("B4:B8,B10:14,B16:B20") 'redundant (Choose one or the other)
Set UID = Range("B4:B8,B10:B14,B16:B20") 'redundant (Choose one or the other)
Set Burnout = ThisWorkbook.Sheets("Burnout_Chart")
If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub
Application.EnableEvents = False
For Z = 1 To Target.Count
If Target(Z).Value > 0 Then
Call movebasedonvalue
End If
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
MaxID = Application.WorksheetFunction.Max(UID)
NewID = MaxID + 1
AR = ActiveCell.Row
Range("B" & AR).Select 'This is what I was missing
ActiveCell.Value = NewID
End If
Next
Application.EnableEvents = True
End Sub