Message box to display warning if cells are not filled out

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
1,714
I have an excel table and upon creating a new row, I want to add code to display a warning message if columns A, E or F are not filled out. What would be the code for this? The table is called tblCosting.
 
Last edited:

Some videos you may like

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
1,714
Actually, I have just found out that my supervisor wants the message box to be displayed when the rows are transferred to the monthly sheets. He then wants the transfer not to happen if certain cells are not filled out.

This is my copy code

Code:
Sub cmdCopy()

Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim tblrow As ListRow
Dim Combo As String
Dim sht As Worksheet
Dim tbl As ListObject
Dim lastrow As Long
Dim DocYearName As String



    Application.ScreenUpdating = False
    
    'assign values to variables
    Set sht = Worksheets("Home")
    
    With sht

        Set tbl = .ListObjects("tblCosting")
        
        
        
        For Each tblrow In tbl.ListRows
            Combo = tblrow.Range.Cells(1, 26).Value
            'lastrow = Worksheets(Combo).Cells(Rows.Count, "A").End(xlUp).Row + 1                                    'number of first empty row in column A of Combo
                If tblrow.Range.Cells(1, 6).Value = "Anglicare Western" Then
                    DocYearName = tblrow.Range.Cells(1, 37).Value
                Else
                    DocYearName = tblrow.Range.Cells(1, 36).Value
                End If
            
            Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
          
                With wsDst
                    'This copies the first 10 columns, i.e. A:J, of the current row of the table to column A in the destination sheet.
                    tblrow.Range.Resize(, 10).copy
                    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    'This should go to the 15th column in the current row, i.e. column O, and copy that column and the next 2 columns, i.e. O:Q, to column K on the destination sheet.
                    tblrow.Range.Offset(, 14).Resize(, 3).copy
                    .Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    'Similarly this should copy columns AD:AF from the table to column N on the destination sheet.
                    tblrow.Range.Offset(, 29).Resize(, 3).copy
                    .Range("N" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                    
                    'Sort rows based on date
                        Rows("3:1000").Select
                        Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Clear
                        Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Add Key:=Range("A4:A1000"), _
                            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                                With Workbooks(DocYearName).Worksheets(Combo).Sort
                                    .SetRange Range("A3:AJ1000")
                                    .Header = xlYes
                                    .MatchCase = False
                                    .Orientation = xlTopToBottom
                                    .SortMethod = xlPinYin
                                    .Apply
                                End With
 
                    
                End With
            
            
        Next tblrow
        
        
    End With
    
    Application.CutCopyMode = False

    Application.ScreenUpdating = True
    
End Sub

The 3 columns are A, E and F for the table. The table starts in column A and if an entry in the table has nothing in these 3 columns in any row, I need it to display an error message saying "ensure the information is all entered" and then to exit the sub without any transfer taking place.

Can someone help me with the code please?
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
19,253
Office Version
  1. 2013
Platform
  1. Windows
Maybe like this.....UNTESTED

Code:
Sub cmdCopy()
Dim wsDst As Worksheet, wsSrc As Worksheet, tblrow As ListRow
Dim Combo As String, sht As Worksheet, tbl As ListObject
Dim lastrow As Long, DocYearName As String
Application.ScreenUpdating = False
'assign values to variables
Set sht = Worksheets("Home")
With sht
    Set tbl = .ListObjects("tblCosting")
[color=red]For Each tblrow In tbl.ListRows
    If tblrow.Range.Cells(1, 1).Value = "" Or tblrow.Range.Cells(1, 5).Value = "" Or tblrow.Range.Cells(1, 6).Value = "" Then
    MsgBox "All values haven't been entered"
    Exit Sub
    End If
    Next tblrow[/color]
    For Each tblrow In tbl.ListRows
        Combo = tblrow.Range.Cells(1, 26).Value
        'lastrow = Worksheets(Combo).Cells(Rows.Count, "A").End(xlUp).Row + 1                                    'number of first empty row in column A of Combo
            If tblrow.Range.Cells(1, 6).Value = "Anglicare Western" Then
                DocYearName = tblrow.Range.Cells(1, 37).Value
            Else
                DocYearName = tblrow.Range.Cells(1, 36).Value
            End If
        Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
            With wsDst
                'This copies the first 10 columns, i.e. A:J, of the current row of the table to column A in the destination sheet.
                tblrow.Range.Resize(, 10).Copy
                .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                'This should go to the 15th column in the current row, i.e. column O, and copy that column and the next 2 columns, i.e. O:Q, to column K on the destination sheet.
                tblrow.Range.Offset(, 14).Resize(, 3).Copy
                .Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                'Similarly this should copy columns AD:AF from the table to column N on the destination sheet.
                tblrow.Range.Offset(, 29).Resize(, 3).Copy
                .Range("N" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                'Sort rows based on date
                    Rows("3:1000").Select
                    Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Clear
                    Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Add Key:=Range("A4:A1000"), _
                        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                            With Workbooks(DocYearName).Worksheets(Combo).Sort
                                .SetRange Range("A3:AJ1000")
                                .Header = xlYes
                                .MatchCase = False
                                .Orientation = xlTopToBottom
                                .SortMethod = xlPinYin
                                .Apply
                            End With
            End With
    Next tblrow
 End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
19,253
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Glad to help and thx for the feedback...(y)


So whereabouts in NSW are you ??
 
Last edited:

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
19,253
Office Version
  1. 2013
Platform
  1. Windows
I was in Parkes....but moved down to the Murray to retire !!!
 

Watch MrExcel Video

Forum statistics

Threads
1,108,955
Messages
5,525,882
Members
409,669
Latest member
JDCupps

This Week's Hot Topics

Top