Option Explicit
Sub FindMissingData()
Dim rData As Range, rCell As Range
Dim wsData As Worksheet, wsMissing As Worksheet
Dim bAllData As Boolean
Dim sQtr As String
Dim iOut As Long, iLastCol As Long, iRow As Long, iCol As Long
'format current quarter
Select Case Month(Now)
Case 1, 2, 3
sQtr = "Q1" & Format(Now, "yy")
Case 4, 5, 6
sQtr = "Q2" & Format(Now, "yy")
Case 7, 8, 9
sQtr = "Q3" & Format(Now, "yy")
Case 10, 11, 12
sQtr = "Q4" & Format(Now, "yy")
End Select
'figure out what user wants to do
If MsgBox("Look for missing data through " & sQtr & "?", vbQuestion + vbYesNo + vbDefaultButton2, "Look For Missing Data") = vbNo Then Exit Sub
If MsgBox("Include non-missing data as well?", vbQuestion + vbYesNo + vbDefaultButton1, "Look For Missing Data") = vbYes Then
bAllData = True
Else
bAllData = False
End If
'set some objects
Set wsData = Worksheets("RawData")
Set wsMissing = Worksheets("MissingData")
Set rData = wsData.Cells(1, 1).CurrentRegion
Application.ScreenUpdating = False
'clear old data
With wsMissing
.Cells(2, 1).Resize(.Rows.Count - 1, 1).EntireRow.Delete
End With
For iLastCol = 3 To rData.Columns.Count
If wsData.Cells(1, iLastCol).Value = sQtr Then Exit For
Next iLastCol
'move data from RawData to MissingData
iOut = 1
With rData
For iRow = 2 To rData.Rows.Count
For iCol = 3 To iLastCol
If bAllData Then
iOut = iOut + 1
wsMissing.Cells(iOut, 1).Value = wsData.Cells(iRow, 1).Value
wsMissing.Cells(iOut, 2).Value = wsData.Cells(iRow, 2).Value
wsMissing.Cells(iOut, 3).Value = wsData.Cells(1, iCol).Value
If Len(Trim(wsData.Cells(iRow, iCol).Value)) = 0 Then
wsMissing.Cells(iOut, 4).Value = "Missing"
Else
wsMissing.Cells(iOut, 4).Value = wsData.Cells(iRow, iCol).Value
End If
ElseIf Len(Trim(wsData.Cells(iRow, iCol).Value)) = 0 Then
iOut = iOut + 1
wsMissing.Cells(iOut, 1).Value = wsData.Cells(iRow, 1).Value
wsMissing.Cells(iOut, 2).Value = wsData.Cells(iRow, 2).Value
wsMissing.Cells(iOut, 3).Value = wsData.Cells(1, iCol).Value
wsMissing.Cells(iOut, 4).Value = "Missing"
End If
Next iCol
Next iRow
End With
Application.ScreenUpdating = True
Call MsgBox("All Done", vbInformation + vbOKOnly, "Look For Missing Data")
End Sub