I have a membership database spreadsheet with about 1000 members, and have developed various macros to extract data for various purposes (different mailing lists, email address files etc). A subroutine in all these checks the databases for empty cells in columns relevant to the macro, and reports an error message if it finds an empty cell (with the location of that cell). The macro basically just steps through every cell in the programmed columns and checks if empty.
Currently this subroutine is tailored for each macro, so that it only checks the relevant columns, as sometimes an empty cell can be valid.
I'd welcome suggestions on two points: is there a more efficient way of testing for empty cells, while at the same time being able to report the location if found. Secondly I'd like to modify the macro so that I could define a list of the columns to check at the beginning of the macro (maybe a comma separated string variable?), so that I can reuse the main code in each macro, rather than have umpteen versions of it.
I've included the current code here, but also attached the file, together with a sample membership database (dummy data) at the end.
Thanks for any ideas.
Option Explicit
Dim MEMFile As String ' filename of Membership Database
Dim ErrNumber As Integer 'error number
Dim CurrentCell As String ' Current cell location, error message for blank cells
Sub Setup()
' Check if Membership*.xls exists and open it (password may be requested)
MEMFile = Dir(ActiveWorkbook.Path & "\Membership*.xls") 'finds the first match
If MEMFile = "" Then 'Membership File not found
ErrNumber = 1
Call ErrMessage
Else
On Error Resume Next
Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & MEMFile
If Err.Number <> 0 Then 'Wrong password entered
ErrNumber = 2
Call ErrMessage
End If
End If
'
' In MEMFile check that there are no blank cells in
' No, Forename, Surname, Address1, Postcode, County down as far as first blank Member No cell
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Current Members").Select
Range("C2").Select
CheckCell:
' Test No not 0 or blank
If ActiveCell.Value <> 0 Then
' Test Forename not blank
ActiveCell.Offset(0, -1).Select
If ActiveCell = "" Then GoTo BlankWarn
' Test Surname not blank
ActiveCell.Offset(0, -1).Select
If ActiveCell = "" Then GoTo BlankWarn
' Test Address 1 not blank
ActiveCell.Offset(0, 3).Select
If ActiveCell = "" Then GoTo BlankWarn
' Test Town not blank
ActiveCell.Offset(0, 1).Select
If ActiveCell = "" Then GoTo BlankWarn
' Test Postcode 1 not blank
ActiveCell.Offset(0, 1).Select
If ActiveCell = "" Then GoTo BlankWarn
' Test County 1 not blank
ActiveCell.Offset(0, 1).Select
If ActiveCell = "" Then GoTo BlankWarn
' Select Next No
ActiveCell.Offset(1, -4).Select
GoTo CheckCell
Else: GoTo EndOfData
End If
'
BlankWarn:
ErrNumber = 3
CurrentCell = ActiveCell.Address
Call ErrMessage
EndOfData:
' Check completed OK
'
' Close Membership.xls without saving
Windows(MEMFile).Activate
ActiveWorkbook.Close False
'
' Unhide screens now work is completed
Application.ScreenUpdating = True
'
End Sub
Sub ErrMessage()
' Macro ErrMessage
'
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'
' Display message with details of error
If ErrNumber = 1 Then
MsgBox "Membership Database file missing, correct error and run setup again"
ElseIf ErrNumber = 2 Then
MsgBox "Incorrect password entered, run setup again"
ElseIf ErrNumber = 3 Then
MsgBox "ERROR - Blank cell found in Membership file at location: " & CurrentCell & " , correct error and run setup again"
Windows(MEMFile).Activate ' Close MEMFile without saving it
ActiveWorkbook.Close False
End If
End
End Sub
Check Membership.xlsMembership (Test Data B).xls
Bookmarks