check certain cells for data before saving file

redspanna

Well-known Member
Joined
Jul 27, 2005
Messages
1,476
Office Version
  1. 2016
Platform
  1. Windows
Hi all,

I have a macro used to save a worksheet, its placed on the DATA sheet.
is there a way so that when the user clicks this button each row 12:200 is checked for empty cells in that row (cells B:P). If a row is found the ref number in column A of each row is placed into next available row in Sheet3

For example :
A12 = 12345
A13 = 6789
A14 = 9876
A15 = 54321

the DATA sheet is populated with various data in rows 12:15
it is found that B12, L12, E14,F14,P15 all have no data, so the values of A12,A14 and A15 are placed into next row in Sheet3

Result in sheet3

A2= 12345 (valuse of A12 in DATA Sheet)
A3= 9876 (value of A14 in DATA Sheet)
A4= 54321 (value of A15 in DATA sheet)

Finally a message box to state there is missing data, for example

"there is missing data from refs 12345 , 9876 , 54321" ie the list pasted into sheet3

Hope somebody can help and understand my goal(s)

Many thanks in advance
 

Some videos you may like

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

MorganO

Active Member
Joined
Nov 21, 2006
Messages
483
This should work for you:

Code:
Sub test()
Dim DisplayMessage As String, FoundBlank As Boolean
DisplayMessage = "There is missing data from refs "
DisplayMessageLength = Len(DisplayMessage)
For I_row = 12 To 200
  FoundBlank = False
  For J_Col = 2 To 15
   If FoundBlank = False Then
     If Worksheets("Data").Cells(I_row, J_Col).Value = "" Then
       Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0) = Cells(I_row, 1).Value
       DisplayMessage = DisplayMessage & Cells(I_row, 1).Value & " , "
       FoundBlank = True
     End If
   End If
  Next J_Col
Next I_row
If Len(DisplayMessage) > DisplayMessageLength Then DisplayMessage = Left(DisplayMessage, Len(DisplayMessage) - 3)
MsgBox DisplayMessage
End Sub

Take care,

Owen
 

redspanna

Well-known Member
Joined
Jul 27, 2005
Messages
1,476
Office Version
  1. 2016
Platform
  1. Windows
Many thanks Owen for taking the time to reply,

Two further questions if I may...

1) is it possible to omit coulmn O from the search
2) is it possible to remove the trailing , , , , , , , , , , , , , , , , ,
when the msgbox is displayed with the refs

EG the msg box shows

"There is missing data from refs 12345,56432,34566, , , , , , , , , , , , , , ,

thanks again
 

MorganO

Active Member
Joined
Nov 21, 2006
Messages
483
1) 1) is it possible to omit coulmn O from the search
2) is it possible to remove the trailing , , , , , , , , , , , , , , , , ,
when the msgbox is displayed with the refs

Yes, to both. You can just add a qualifier to the first if statement in the code to exclude column O (15) and to check to see if the A row is blank, if so, don't do the check for blanks.

Also, I realized I forgot to include the 'P' column in the code (column 16). Here is the revised code:

Code:
Sub test()
Dim DisplayMessage As String, FoundBlank As Boolean
DisplayMessage = "There is missing data from refs "
DisplayMessageLength = Len(DisplayMessage)
For I_row = 12 To 200
  FoundBlank = False
  For J_COL = 2 To 16
   If FoundBlank = False And J_COL <> 15 And Cells(I_row, 1) <> "" Then
     If Worksheets("Data").Cells(I_row, J_COL).Value = "" Then
       Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0) = Cells(I_row, 1).Value
       DisplayMessage = DisplayMessage & Cells(I_row, 1).Value & " , "
       FoundBlank = True
     End If
   End If
  Next J_COL
Next I_row
If Len(DisplayMessage) > DisplayMessageLength Then DisplayMessage = Left(DisplayMessage, Len(DisplayMessage) - 3)
MsgBox DisplayMessage
End Sub

Take care.

Owen
 

redspanna

Well-known Member
Joined
Jul 27, 2005
Messages
1,476
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Perfect, thanks very much Owen!!
 

redspanna

Well-known Member
Joined
Jul 27, 2005
Messages
1,476
Office Version
  1. 2016
Platform
  1. Windows
Hi all

'Owen' very kindly gave me the code above to check for any missing data in certain cells before saving a worksheet.
I am just running a final test on my sheet and found that the above code doesn't actually save the sheet if no errors are found it just displays the msg
"There is missing data from refs"

can anybody tweak the code so that if all criteria are met the sheet is saved?

thanks
 

MorganO

Active Member
Joined
Nov 21, 2006
Messages
483

ADVERTISEMENT

In your first post I thought you indicated were already saving the spreadsheet somewhere else in the code. Are you saying that you want the spreadsheet to be saved only if no missing data is found?

Owen
 

redspanna

Well-known Member
Joined
Jul 27, 2005
Messages
1,476
Office Version
  1. 2016
Platform
  1. Windows
Hi Owen

Thanks for your reply

Are you saying that you want the spreadsheet to be saved only if no missing data is found?

Basically yes that is what I would like the code to do

thanks
 

MorganO

Active Member
Joined
Nov 21, 2006
Messages
483
This should do it:

Rich (BB code):
Sub test()
Dim DisplayMessage As String, FoundBlank As Boolean
DisplayMessage = "There is missing data from refs "
DisplayMessageLength = Len(DisplayMessage)
For I_row = 12 To 200
  FoundBlank = False
  For J_COL = 2 To 16
   If FoundBlank = False And J_COL <> 15 And Cells(I_row, 1) <> "" Then
     If Worksheets("Data").Cells(I_row, J_COL).Value = "" Then
       Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0) = Cells(I_row, 1).Value
       DisplayMessage = DisplayMessage & Cells(I_row, 1).Value & " , "
       FoundBlank = True
     End If
   End If
  Next J_COL
Next I_row
If Len(DisplayMessage) > DisplayMessageLength Then 
  DisplayMessage = Left(DisplayMessage, Len(DisplayMessage) - 3)
Else
<code> ActiveWorkbook.Save</code> 
End If
MsgBox DisplayMessage
End Sub
Take Care.

Owen
 

redspanna

Well-known Member
Joined
Jul 27, 2005
Messages
1,476
Office Version
  1. 2016
Platform
  1. Windows
Hi Owen,

Sorry to be a pain, but the code almost works,
it now DOES save the worksheet if no data missing, BUT after saving it still shows the msg box "There is missing data from refs"

any help?
 

Watch MrExcel Video

Forum statistics

Threads
1,122,509
Messages
5,596,568
Members
414,079
Latest member
Frills

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top