This isn't pretty, but it may give you an idea of what to do. I've
placed it in the workbook before closing event
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'constants
'constants
HomeQCell = "A3" 'question
HomeACell = "B3" 'answer
HomeMCell = "A1" 'missing
QSheet = "Sheet1"
MissingAnsSheet = "Sheet2"
'turn off so not prompted to 'resave' book
Application.DisplayAlerts = False
'save user position
UserSheet = ActiveSheet.Name
UserCell = ActiveCell.Address
TheVertScroll = ActiveWindow.ScrollRow
TheHorzScroll = ActiveWindow.ScrollColumn
'determine where to grab
Sheets(QSheet).Activate
Range(HomeQCell).Select
'find last filled row
ThisCell = -1 'dummy
While ActiveCell.Address <> ThisCell
ThisCell = ActiveCell.Address
Selection.End(xlDown).Select
Wend
Selection.End(xlUp).Select
LastQCell = ActiveCell.Address
NumQs = Range(LastQCell).Row - Range(HomeQCell).Row + 1
'place data into arrays
QCol = Range(HomeQCell, LastQCell).Value
LastACell = Cells(Range(HomeACell).Row + NumQs - 1,
Range(HomeACell).Column).Address
ACol = Range(HomeACell, LastACell).Value
'count number of FALSE
NumFalse = Application.CountIf(Range(HomeACell, LastACell), False)
'put Q of FALSE A into array ...
If NumFalse <> 0 Then
ReDim MissingA(1 To NumFalse, 1 To 1)
cnt = 0
For i = 1 To NumQs
If ACol(i, 1) = False And Not IsEmpty(ACol(i, 1)) Then
cnt = cnt + 1
MissingA(cnt, 1) = QCol(i, 1)
End If
Next i
'... put into sheet
Sheets(MissingAnsSheet).Activate
Range(HomeMCell).Resize(NumFalse, 1).Value = MissingA
End If
'restore userposition
Sheets(UserSheet).Activate
Range(UserCell).Select
ActiveWindow.ScrollRow = TheVertScroll
ActiveWindow.ScrollColumn = TheHorzScroll
'save book
ActiveWorkbook.Save
'restore warnings
Application.DisplayAlerts = True
End Sub