• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Check for empty cells across multiple sheets and return values

Nu2Java

Member
Hi All - I have a workbook with approx 100 sheets. I want to be able to check every sheet that has data in Column A. If the adjacent cell in column B is blank, return the value from column A. (** If cell A5 has data, then B5 should have data. If B5 is blank, tell me what the value is in A5). It would also be great to know the values from which sheet they were missing. Hopefully I worded this correctly. Thanks for any help on this, I cannot find exactly what I am looking for in my searching. Office 365
 

Attachments

  • Missing Values.xlsx
    13.2 KB · Views: 2
Last edited:
Hi, you should detail your 'return the value from column A' with a better explanation​
so with nothing to guess and to raise your chances with a before / after workbook sample …​
 
Let's have a file with, say 5 sheets in, with realistic data in each with about 10 rows on each sheet. It will answer lots of questions that we'll probably guess (wrongly) the answers to.
What version of Excel?

A formula such as:
=LET(a,VSTACK(Sheet1:Sheet5!$A$1:$B$12),FILTER(TAKE(a,,1), TAKE(a,,-1)="","no blanks"))
will show the values, but not the sheet it comes from.
 
Thanks. I have attached a sample workbook. There are missing values in each sheet. I expect there will be plenty of duplicates in all sheets, but that's ok.
 
Last edited by a moderator:
Try:
Code:
Sub blah()
NewSheetName = "Summary"                         'adjust this to a sheet name of your liking.
Application.DisplayAlerts = False
On Error Resume Next
Sheets(NewSheetName).Delete
On Error GoTo 0
Application.DisplayAlerts = True

Set Newsht = ThisWorkbook.Sheets.Add(After:=Sheets(ThisWorkbook.Sheets.Count))
Newsht.Name = NewSheetName

Set Destn = Newsht.Range("A2")
For Each sht In ThisWorkbook.Worksheets
  Set Rng = Nothing
  With sht
    If .Name <> NewSheetName Then
      Set Rng = Intersect(.Range("A:A"), .UsedRange)
      If Not Rng Is Nothing Then
        For Each cll In Rng.Cells
          If Len(Application.Trim(cll.Value)) > 0 Then
            If Len(Application.Trim(cll.Offset(, 1).Value)) = 0 Then
              Destn.Value = cll.Value: Destn.Offset(, 1).Value = sht.Name & " row " & cll.Row
              Set Destn = Destn.Offset(1)
            End If
          End If
        Next cll
      End If
    End If
  End With
Next sht
End Sub
edit: I've made some changes to the above code since first posting it!

1712678657680.png
 
Last edited:
You might like this small change:
Code:
            If Len(Application.Trim(cll.Offset(, 1).Value)) = 0 Then
              Destn.Value = cll.Value
              NewSht.Hyperlinks.Add Anchor:=Destn.Offset(, 1), Address:="", SubAddress:=cll.Offset(, 1).Address(0, 0, External:=True), TextToDisplay:=sht.Name & " row " & cll.Row
              Set Destn = Destn.Offset(1)
            End If
 
Thanks Marc L I updated the question with some detail.
But the destination is still missing ! (text file, screen, worksheet, …)​
Anyway following p45cal sample according to your initial post attachment a VBA demonstration to better paste to ThisWorkbook module :​
Code:
Sub Demo1()
  Const B = "Blanks"
    Dim R&, Ws As Worksheet, Rc As Range
        R = 1
        Application.ScreenUpdating = False
     If IsObject(Evaluate("'" & B & "'!A1")) Then
        Sheets(B).UsedRange.Offset(1).Clear
        Sheets(B).Select
     Else
        Sheets.Add(, Sheets(Sheets.Count)).Name = B
        [A1:B1].Font.Bold = True
        [A1:B1].HorizontalAlignment = xlCenter
        [A1:B1] = [{"Address","Part  #"}]
     End If
    For Each Ws In Worksheets
     If Ws.Name <> B And Application.CountBlank(Ws.UsedRange.Columns(2)) Then
    For Each Rc In Ws.UsedRange.Columns(2).SpecialCells(4)
        R = R + 1
        Rows(R).Columns("A:B") = Array(Ws.Name & " : A" & Rc.Row, Rc(1, 0))
    Next
     End If
    Next
        [A1].CurrentRegion.NumberFormat = "_0@ "
        [A1].CurrentRegion.Columns.AutoFit
        Application.ScreenUpdating = True
End Sub
Do you like it ? So thanks to click on bottom right Like !​
 
You might like this small change:
Code:
            If Len(Application.Trim(cll.Offset(, 1).Value)) = 0 Then
              Destn.Value = cll.Value
              NewSht.Hyperlinks.Add Anchor:=Destn.Offset(, 1), Address:="", SubAddress:=cll.Offset(, 1).Address(0, 0, External:=True), TextToDisplay:=sht.Name & " row " & cll.Row
              Set Destn = Destn.Offset(1)
            End If
Remove both IF statements and replace with this single IF ?
 
But the destination is still missing ! (text file, screen, worksheet, …)​
Anyway following p45cal sample according to your initial post attachment a VBA demonstration to better paste to ThisWorkbook module :​
Code:
Sub Demo1()
  Const B = "Blanks"
    Dim R&, Ws As Worksheet, Rc As Range
        R = 1
        Application.ScreenUpdating = False
     If IsObject(Evaluate("'" & B & "'!A1")) Then
        Sheets(B).UsedRange.Offset(1).Clear
        Sheets(B).Select
     Else
        Sheets.Add(, Sheets(Sheets.Count)).Name = B
        [A1:B1].Font.Bold = True
        [A1:B1].HorizontalAlignment = xlCenter
        [A1:B1] = [{"Address","Part  #"}]
     End If
    For Each Ws In Worksheets
     If Ws.Name <> B And Application.CountBlank(Ws.UsedRange.Columns(2)) Then
    For Each Rc In Ws.UsedRange.Columns(2).SpecialCells(4)
        R = R + 1
        Rows(R).Columns("A:B") = Array(Ws.Name & " : A" & Rc.Row, Rc(1, 0))
    Next
     End If
    Next
        [A1].CurrentRegion.NumberFormat = "_0@ "
        [A1].CurrentRegion.Columns.AutoFit
        Application.ScreenUpdating = True
End Sub
Do you like it ? So thanks to click on bottom right Like !​
Thanks Marc L I will try this out. Will this show any different result if column B's value contains a formula?
 
As I wrote « according to your initial post attachment » … So weird your attachment does not well reflect the real data !​
With a formula the cell can't be empty so in this case stay with p45cal slower way (or post #14 Demo2).​
 
Only Part Number should be necessary with a hyperlink and​
in case of any formula within column B another VBA demonstration (v2) to better paste to ThisWorkbook module :​
Code:
Sub Demo2()
  Const M = "Missing Location"
    Dim R&, Ws As Worksheet, V, S$
        R = 1
        Application.ScreenUpdating = False
     If IsObject(Evaluate("'" & M & "'!A1")) Then
        Sheets(M).UsedRange.Offset(1).Clear
        Sheets(M).Select
     Else
        Sheets.Add(, Sheets(Sheets.Count)).Name = M
        Sheets(1).[A1].Copy [A1]
     End If
    For Each Ws In Worksheets
        V = Ws.Evaluate(Replace("TRANSPOSE(IF(#="""",ROW(#)))", "#", Ws.UsedRange.Columns(2).Address))
     If Ws.Name <> M And IsArray(V) Then
    For Each V In Filter(V, False, False)
        R = R + 1
        S = "'" & Ws.Name & "'!B" & V
        ActiveSheet.Hyperlinks.Add Cells(R, 1), "", S, S, Ws.Range("A" & V).Value
    Next
     End If
    Next
        Application.ScreenUpdating = True
End Sub
Do you like it ? So thanks to click on bottom right Like !​
 
Back
Top