I'm struggling with some VBA code and the BeforeSave methodology. I've been all over the forums but can't locate the answer I need, so would love some help please. My question! On saving I need the code to look at Column H (named Claim USD) of a 'Table' (named Claims) for a number value and then if any of the cells has a value to then look at Column I (named Claim Date) and make sure there is a date in there. I have already data validated column I to only accept date entries.

I have found the code below, and tested it for what it does and it works. I'm just not sure how to incorporate my element. Can anyone offer me some help?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim rsave As Range
Dim cell As Range
Set rsave = Sheet2.Range("I8,I500")

For Each cell In rsave

If cell = "" Then

Dim missdata
missdata = MsgBox("missing data", vbOKOnly, "Missing Data")
Cancel = True
cell.Select

Exit For

End If

Next cell

End Sub
有帮助吗?

解决方案

I have created a custom Class for validation see here. It is very overkill for what you are trying to do but what it will allow you to do is capture all of the cells with errors and do what you'd like with them. You can download and import the 2 class modules Validator.cls and ValidatorErrors.cls And then use the following

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Unflag
  Dim rsave As Range
  Dim rcell As Range
  Dim v AS New Validator

  Set rsave = Sheet2.Range("Table1[Estimate Date]")
  with v
    For Each rcell In rsave
      .validates rcell,rcell.address
         .presence
    Next rcell
 End With
 If not(v.is_valid) Then
     FlagCollection v.errors
     MsgBox("Missing data in " & v.unique_keys.Count & " Cell(s).", vbOKOnly, "Missing Data")
     Cancel = True
 End IF
 Set v = Nothing
End Sub

Public Sub flag(flag As String, comment As String)
  Dim comments As String
  If has_comments(flag) Then
   comments = Sheet2.Range(flag).comment.Text & vbNewLine & comment
  Else
    comments = comment
  End If
  Sheet2.Range(flag).Interior.Color = RGB(255, 255, 102)
  Sheet2.Range(flag).ClearComments
  Sheet2.Range(flag).AddComment comments
End Sub

Public Sub FlagCollection(all_cells As Collection)
  Dim flag_cell As ValidatorError

  For Each flag_cell In all_cells
    flag flag_cell.field, flag_cell.error_message
  Next flag_cell
End Sub

Public Sub Unflag()
  Cells.Select
  Selection.Interior.ColorIndex = xlNone
  Selection.ClearComments
End Sub

Public Function has_comments(c_cell As String) As Boolean
   On Error Resume Next
   Sheet1.Range(c_cell).comment.Text
   has_comments = Not (CLng(Err.Number) = 91)
End Function

This will flag every field that has an error in yellow and add a comment as to what the issue is you could also determine a way to tell the user exactly where the errors are using v.uniq_keys which returns a collection of cell address' that fail validation of presence.

其他提示

I'm pretty sure I cracked it, well it works anyway. Code below (for those who are interested anyway!!)

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

     Dim rsave As Range
     Dim cell As Range

     Set rsave = Sheet2.Range("Table1[Estimated Claim (USD)]")

     For Each cell In rsave

          If cell.Value <> "" And cell.Offset(0, 1).Value = "" Then

          Dim missdata
          missdata = MsgBox("Missing Data - Enter the Date for WorkBook to Save", vbOKOnly, "Missing Data")
          Cancel = True
          cell.Offset(0, 1).Select

      Exit For

      End If

      Next cell

 End Sub

I've now got to loop this through three other column headers checking for same criteria. If anyone knows a quicker code method. Would appreciate the help!

许可以下: CC-BY-SA归因
不隶属于 StackOverflow
scroll top