Mark cell as complete

[fatalcore]

Hi,
I have a worksheet containing lots of data..
There are few cells which are mandatory.What I want is if these cells A12,A14,B16,C15,D15,G19,E1,E2,E4,E5,F12,H1 are filled up then in a seperate sheet called "Status" then in cell B6 value should be written as complete,untill then status should be Incomplete.

And the cells C6 to righthand side should contain the cells which are yet to get completed.

Thanks in advance.

[p45cal]

In B6 of the Status sheet:
=IF(COUNTA(Sheet14!A12,Sheet14!A14,Sheet14!B16,Sheet14!C15,Sheet14!D15,Shee t14!G19,Sheet14!E1,Sheet14!E2,Sheet14!E4,Sheet14!E5,Sheet14!F12,Sheet14!H1) =12,"Complete","Not Complete")

replace Sheet14 with your sheet's name.
and…

[Aussiebear]

Would it be easier to msgbox those cells not yet completed?

[Kenneth Hobs]

As p45cal said for complete incomplete:
=IF(COUNTA(Sheet1!A12,Sheet1!A14,Sheet1!B16,Sheet1!C15,Sheet1!D15,Sheet1!G1 9,Sheet1!E1,Sheet1!E2,Sheet1!E4,Sheet1!E5,Sheet1!F12,Sheet1!H1)=12,"Complet e","Incomplete")

Insert a Module with this code, set the reference, and in Status!C6:
=stremptyrange("Sheet1!A12,Sheet1!A14,Sheet1!B16,Sheet1!C15,Sheet1!D15,Shee t1!G19,Sheet1!E1,Sheet1!E2,Sheet1!E4,Sheet1!E5,Sheet1!F12,Sheet1!H1")
[vba]'Early Binding method requires Reference: Tools > References... > MicroSoft Scripting Runtime, scrrun.dll
Function strEmptyRange(sRange As String) As String
Dim aRange As Range, d As Dictionary, c As Range, s as string

Application.Volatile True

If d Is Nothing Then Set d = New Dictionary 'Early Binding Method
'If d is nothing then Set d = CreateObject("Scripting.Dictionary") 'Late Binding method
Set aRange = Range(sRange)
For Each c In aRange
If IsEmpty(c) Then d.Add c.Address(False, False), Empty
Next c

s = Join(d.Keys, ", ")
Set d = Nothing
strEmptyRange = s
End Function[/vba]

A conditional formatting approach might be more visual though.

[p45cal]

In B6 of the Status sheet:
=IF(COUNTA(Sheet14!A12,Sheet14!A14,Sheet14!B16,Sheet14!C15,Sheet14!D15,Shee t14!G19,Sheet14!E1,Sheet14!E2,Sheet14!E4,Sheet14!E5,Sheet14!F12,Sheet14!H1) =12,"Complete","Not Complete")

replace Sheet14 with your sheet's name.
and…

… C6 formula:

=WhatsMissing((Sheet14!A12,Sheet14!A14,Sheet14!B16, Sheet14!C15,Sheet14!D15,Sheet14!G19,Sheet14!E1, Sheet14!E2,Sheet14!E4,Sheet14!E5,Sheet14!F12,Sheet14!H1))

Supported by the user defined function:
[vba]Function WhatsMissing(theRange)
For Each cll In theRange.Cells
If cll = Empty Then WhatsMissing = WhatsMissing & cll.Address(0, 0) & ","
Next cll
If WhatsMissing <> Empty Then WhatsMissing = Left(WhatsMissing, Len(WhatsMissing) - 1)
End Function
[/vba]not forgetting to replace Sheet14 with your sheet's name again.

[fatalcore]

Waooo...you people are brilliant.
Just a small update, Can the missing cells also be hyperlinked with one another in the status sheet? It will be a life saver.
Thanks in advance.

[mikerickson]

[VBA]Function TestIfFilled() As Boolean
Dim uiValue As Variant
Dim oneCell As Range
Dim strPrompt As String
Dim shtMemory As Worksheet
Set shtMemory = ActiveSheet

Sheet1.Activate
For Each oneCell In Sheet1.Range("A12,A14,B16,C15,D15,G19,E1,E2,E4,E5,F12,H1").Cells
strPrompt = "Cell " & oneCell.Value & " is empty." & vbCr & "What should it be filled with?"

Do Until oneCell.Value <> vbNullString
uiValue = Application.InputBox("Cell " & oneCell.Address & "is empty", Type:=2)
If uiValue = "False" Then shtMemory.Activate: Exit Function: Rem cancel pressed

If IsDate(uiValue) Then
uiValue = DateValue(uiValue)
ElseIf IsNumeric(uiValue) Then
uiValue = Val(uiValue)
End If

oneCell.Value = uiValue
Loop
Next oneCell
shtMemory.Activate
TestIfFilled = True
End Function[/VBA]

[fatalcore]

Hi, I was just wondering if this could be possible that in a hidden sheet I map the cells which are mandatory to be filled up,and i use a formula in a status sheet to basically pull up the values and then hyperlink them.
I am attaching a dummy sheet for reference.
I have hiddedn the sheet called mandatorycells which sheet basically contains the mapping of the mandatory fields.
Thanks in advance.

[mikerickson]

I'm not sure what you mean by "pull them up and hyperlink them".

In the attached, running CheckCellEntries will loop through all the unfilled required cells listed in MandatoryCells. It also puts formulas in the sheet MandatoryCells that feed the counting in Status!C8.

If you add (or remove) manditory cells in sheet MandatoryCells:

1) the sub CheckCellEntries should be run to account for the new mandatory list
2) the Sheet name in column A must match (no extra spaces) the tab name of the sheet.


Note, as attached (with ForceEntry = False) then CheckCellEntries loop will allow the user to enter a value or "" or Cancel to end the sub.

If ForceEntry=True, entering "" causes the user to be asked about the same cell again.

[fatalcore]

Hi mikerickson,

Thanks for your reply, but I don't want some so complex. I want a simple thing.

I am re framing the requirement to make stuff easy.

1. I basically manually insert the cells which needs to have some data in the sheet " MandatoryCells ".

2.Now , When I click the button "Check which cells are not filled and hyperlink them" the code will search if the sheet name is hidden or not , if the sheet is hidden then it will skip the row and go to the next row.At the same time it will mark "N/A" in the status ie. Column A

3. Now say if A1 in sheet4 is not filled then the code will simply hyperlink A1 to sheet4 else if there is content present. It will move to the next cell.

4.Now, if it creates any hyperlink then the first cell of the row will mark as Incomplete else it will mark as Complete.

That's it.
Thanks a ton for all your efforts.

[Kenneth Hobs]

You have no sheet named "Sheet 2" or any of the others since you added the space character. You have to be literal if you expect code to do what you want.

If you want a "simple thing" then it would have already received an answer. Don't let seemingly complicated solutions stop you from using them. No matter how complicated the Function or Sub, if written properly, may seem "complicated".

Right click the sheet tab with the CommandButton1 control, View Code, and paste:
[vba]Private Sub CommandButton1_Click()
Dim r As Range, c As Range, i As Long, ws As Worksheet
Dim theRange As Range

SpeedOn
On Error GoTo EndSub

For i = 13 To Range("A" & Rows.Count).End(xlUp).Row
Set r = Range("B" & i)

If Not WorkSheetExists(r.Value2) Then GoTo NextI
Set ws = Worksheets(r.Value2)

Set theRange = Worksheets(ws.Name).Range(Range("C" & i).Value2)
For Each c In Range(Range("C" & i), Range("C" & i).End(xlToRight))
Set theRange = Union(theRange, Worksheets(ws.Name).Range(c.Value2))
Next c

'Set N/A, Complete, or Incomplete
Range("A" & i).Value2 = AllRangeComplete(theRange)

For Each c In Range("C" & i, Range("C" & i).End(xlToRight))
c.Hyperlinks.Delete
If Not IsEmpty(ws.Range(c.Value2)) Then ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _
ws.CodeName & "!" & c.Value2, TextToDisplay:=c.Value2
Next c
NextI:
Next i

EndSub:
SpeedOff
End Sub
[/vba]
Obviously, change the number 13 if your data does not start at row 13 as in your example. The code assumes that there are at least two cells to monitor. If just one or none, an adjustment is needed for the xlToRight code parts. Normally, I set the first cell and then use xlToLeft from the last cell in a row.

You will notice that I used my Speed routines from, http://vbaexpress.com/kb/getarticle.php?kb_id=1035. Comment out those lines or add the Module.

In a Module, add:
[vba]Function WorkSheetExists(sWorkSheet As String, Optional sWorkbook As String = "") As Boolean
Dim ws As Worksheet, wb As Workbook
On Error GoTo notExists
If sWorkbook = "" Then
Set wb = ActiveWorkbook
Else
Set wb = Workbooks(sWorkbook)
End If
Set ws = wb.Worksheets(sWorkSheet)
WorkSheetExists = True
Exit Function
notExists:
WorkSheetExists = False
End Function

'For theRange, Return: N/A, Complete, or Incomplete
Function AllRangeComplete(theRange As Range) As String
Dim cll As Range
AllRangeComplete = "Complete"
For Each cll In theRange
If cll.Worksheet.Visible = False Then
AllRangeComplete = "N/A"
Exit Function
End If
If IsEmpty(cll) Then
AllRangeComplete = "Incomplete"
Exit Function
End If
Next cll
End Function
[/vba]

[fatalcore]

Hi Kenneth,
Thanks for your support. I am extremely sorry if I have offended you. I have exactly as you said. Also I am sorry for writing the wrong sheet name.
I have changed and corrected the names of the sheet. However the is not working after row 16.As well as the hyperlinking is getting to some other sheets.
Can you please help? Thanks in advance.

[Kenneth Hobs]

I don't get offended easily. My comments should always be taken as a way to help.

Why do you say that it does not work. If there is no data in that row's sheet for those cells, then it seemingly does nothing but then that is expected.

Change the Hyperlinks.Add line to:
[vba] If Not IsEmpty(ws.Range(c.Value2)) Then ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _
ws.Name & "!" & c.Value2, TextToDisplay:=c.Value2[/vba]

[fatalcore]

Hi Kenneth,
Thanks for your support.
That sorted out the problem ! You are right !!! Wonderful Sir !!!

[Kenneth Hobs]

To Not or Not I guess:
[vba]Private Sub CommandButton1_Click()
Dim r As Range, c As Range, i As Long, ws As Worksheet
Dim theRange As Range

SpeedOn
On Error GoTo EndSub

For i = 13 To Range("A" & Rows.Count).End(xlUp).Row
Set r = Range("B" & i)

If Not WorkSheetExists(r.Value2) Then GoTo NextI
Set ws = Worksheets(r.Value2)

Set theRange = Worksheets(ws.Name).Range(Range("C" & i).Value2)
For Each c In Range(Range("C" & i), Range("C" & i).End(xlToRight))
Set theRange = Union(theRange, Worksheets(ws.Name).Range(c.Value2))
Next c

'Set N/A, Complete, or Incomplete
Range("A" & i).Value2 = AllRangeComplete(theRange)

For Each c In Range("C" & i, Range("C" & i).End(xlToRight))
c.Hyperlinks.Delete
If IsEmpty(ws.Range(c.Value2)) Then ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _
ws.Name & "!" & c.Value2, TextToDisplay:=c.Value2
Next c
NextI:
Next i

EndSub:
SpeedOff
End Sub[/vba]

[fatalcore]

Hats off to u kenneth !!!
Thanks mate !