[Example of one Table][2]
I have a structure of an Excel Project with 5 tables that are being updated regularly. I am currently working on finding a way to validate entered data and set a frame and a specific datatype for certain columns. If there is a wrong entry it should return a message. I have tried using vba, but since I am not experienced at all I struggled to implement a working code. The data check option from excel did not work so far either since there should also be the option to copy and paste several datasets in the table at once. It also keeps resetting as soon as i close the project.
Is it a good idea to keep trying it with vba?
My idea is to run through each column in a loop and check each entry for certain requirements assigned to the column. There should be a message box throwing an error in case that the entered data has the wrong datatype or is out of the chosen range.
Sub CheckColumns()
Dim rng As Range
Dim lCol As Long, lRow As Long
lCol = Range("C2").End(xlToRight).Column
lRow = Range("C2").End(xlDown).Row
For Each rng In Range("C2", Cells(lRow, lCol))
If IsNumeric(rng) = False Then
MsgBox ("A number has to be entered " & "Row " & rng.Row &
" Column " & rng.Column)
rng.Font.ColorIndex = 3
End If
Next rng
End Sub
Put this in your worksheet module:
Private Sub Worksheet_Change(ByVal Target As Range)
'Declarations.
Dim RngNameColumn As Range
Dim RngLenghtColumn As Range
Dim RngWidthColumn As Range
Dim RngHeightColumn As Range
Dim RngIntersection As Range
Dim RngCell As Range
Dim StrMessage As String
Dim StrMessageReason As String
Dim BytCounter As Byte
Dim DblLenghtMax As Double
Dim DblWidthMax As Double
Dim DblHeightMax As Double
Dim DblLenghtMin As Double
Dim DblWidthMin As Double
Dim DblHeightMin As Double
'Settings.
Set RngNameColumn = Me.Range("B:B")
Set RngLenghtColumn = Me.Range("C:C")
Set RngWidthColumn = Me.Range("D:D")
Set RngHeightColumn = Me.Range("E:E")
DblLenghtMax = 5000
DblWidthMax = 243
DblHeightMax = 4354
DblLenghtMin = 2354
DblWidthMin = 24
DblHeightMin = 333
'Setting the first part of StrMessage.
StrMessage = "Invalid input:"
'___________________________
'RngNameColumn Block - Start
'---------------------------
'In this block RngNameColumn is checked for invalid input.
'Setting RngIntersection.
Set RngIntersection = Intersect(Target, RngNameColumn)
'Setting the StrMessageReason accordingly to the block need.
StrMessageReason = ": no digits allowed"
'Checking if RngIntersection is something.
If Not RngIntersection Is Nothing Then
'Covering each cell of RngIntersection.
For Each RngCell In RngIntersection
'Covering each digit.
For BytCounter = 0 To 9
'Checking if RngCell contains any digit.
If Len(RngCell.Value) <> Len(Excel.WorksheetFunction.Substitute(RngCell.Value, BytCounter, "")) And _
RngCell.Value <> "" Then
'Setting StrMessage.
StrMessage = StrMessage & vbCrLf & "-range " & RngIntersection.EntireColumn.Address(0, 0) & StrMessageReason
'When the first invalid input of the block is found, the block is left.
GoTo CP_RngNameColumnEnd
End If
Next
Next
End If
CP_RngNameColumnEnd:
'___________________________
'RngNameColumn Block - End
'---------------------------
'_____________________________
'RngLenghtColumn Block - Start
'-----------------------------
'In this block RngLenghtColumn is checked for invalid input.
'Setting RngIntersection.
Set RngIntersection = Intersect(Target, RngLenghtColumn)
'Setting the StrMessageReason accordingly to the block need.
StrMessageReason = ": has be be a number between " & DblLenghtMax & " and " & DblLenghtMin
'Checking if RngIntersection is something.
If Not RngIntersection Is Nothing Then
'Covering each cell of RngIntersection.
For Each RngCell In RngIntersection
'Checking if RngCell does not contain a number within the specified limits.
If (IsNumeric(RngCell.Value) = False Or _
RngCell.Value < DblLenghtMin Or _
RngCell.Value > DblLenghtMax _
) And _
RngCell.Value <> "" Then
'Setting StrMessage.
StrMessage = StrMessage & vbCrLf & "-range " & RngIntersection.EntireColumn.Address(0, 0) & StrMessageReason
'When the first invalid input of the block is found, the block is left.
GoTo CP_RngLenghtColumnEnd
End If
Next
End If
CP_RngLenghtColumnEnd:
'_____________________________
'RngLenghtColumn Block - End
'-----------------------------
'_____________________________
'RngWidthColumn Block - Start
'-----------------------------
'In this block RngWidthColumn is checked for invalid input.
'Setting RngIntersection.
Set RngIntersection = Intersect(Target, RngWidthColumn)
'Setting the StrMessageReason accordingly to the block need.
StrMessageReason = ": has be be a number between " & DblWidthMax & " and " & DblWidthMin
'Checking if RngIntersection is something.
If Not RngIntersection Is Nothing Then
'Covering each cell of RngIntersection.
For Each RngCell In RngIntersection
'Checking if RngCell does not contain a number within the specified limits.
If (IsNumeric(RngCell.Value) = False Or _
RngCell.Value < DblWidthMin Or _
RngCell.Value > DblWidthMax _
) And _
RngCell.Value <> "" Then
'Setting StrMessage.
StrMessage = StrMessage & vbCrLf & "-range " & RngIntersection.EntireColumn.Address(0, 0) & StrMessageReason
'When the first invalid input of the block is found, the block is left.
GoTo CP_RngWidthColumnEnd
End If
Next
End If
CP_RngWidthColumnEnd:
'_____________________________
'RngWidthColumn Block - End
'-----------------------------
'_____________________________
'RngHeightColumn Block - Start
'-----------------------------
'In this block RngHeightColumn is checked for invalid input.
'Setting RngIntersection.
Set RngIntersection = Intersect(Target, RngHeightColumn)
'Setting the StrMessageReason accordingly to the block need.
StrMessageReason = ": has be be a number between " & DblHeightMax & " and " & DblHeightMin
'Checking if RngIntersection is something.
If Not RngIntersection Is Nothing Then
'Covering each cell of RngIntersection.
For Each RngCell In RngIntersection
'Checking if RngCell does not contain a number within the specified limits.
If (IsNumeric(RngCell.Value) = False Or _
RngCell.Value < DblHeightMin Or _
RngCell.Value > DblHeightMax _
) And _
RngCell.Value <> "" Then
'Setting StrMessage.
StrMessage = StrMessage & vbCrLf & "-range " & RngIntersection.EntireColumn.Address(0, 0) & StrMessageReason
'When the first invalid input of the block is found, the block is left.
GoTo CP_RngHeightColumnEnd
End If
Next
End If
CP_RngHeightColumnEnd:
'_____________________________
'RngHeightColumn Block - End
'-----------------------------
'If StrMessage has changed since its initial value, it is reported.
If StrMessage <> "Invalid input:" Then
MsgBox StrMessage, vbCritical + vbOKOnly, "Invalid input"
End If
End Sub