Consulting

Results 1 to 7 of 7

Thread: Need Help Finding Specific Cells and Determining if there are values in it or not

  1. #1

    Talking Need Help Finding Specific Cells and Determining if there are values in it or not

    VBA Help.jpg

    Attaching a photo so it helps me explain it better. Essentially what I have to do is determine if there are values in a specific cell, returning "found" if there is and "missing" if there is not. I want to do this for each company's metric. Example: For Amazon, I want to determine if their Revenue metric for Q2-21 is available or missing. Thus, I need to make sure it is pinpointing the exact cell it would fall in and not finding the previous quarter's value and stating that it was found. It would be even better if someone could teach me how to make it update automatically based off of which quarter we fall in (in September, it would search for Q321 and so on). I'm really lost and would greatly appreciate some help here, you guys are awesome! Let me know if I can clarify anything for you all. Much appreciated.
    Last edited by SamT; 06-23-2021 at 12:25 PM.

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,704
    Location
    I can't see a single word on that image. How about uploading the Spreadsheet?
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  3. #3
    VBA Work.xlsm

    VBA Work.xlsm
    Sorry new to this site, can you access this?VBA Work.xlsm

    Quote Originally Posted by SamT View Post
    I can't see a single word on that image. How about uploading the Spreadsheet?

  4. #4
    Lol I'm a clown and don't know how to use this site yet but I posted a comment below that should have the attachment. Any help is much appreciated thank you very much.

  5. #5
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,704
    Location
    I hate using Tab Names in code, So I changed the CodeName of Sheet2 to "CompanyMetrics"
    The Formulas in Sheet1, which reflect the missing values, uses the UserDefinedFuction "GetMissing" in Module1, That Function uses the Public Function "IsMissing" in Worksheet Module "CompanyMetrics"

    This only works on the current quarter, all other columns will be empty. It currently requires 4 metrics per company


    Formulas; =IF(GetMissing($A2,$B2,C$1),"Missing","")

    UserDefinedFunction in Module1:
    Public Function GetMissing(Company As Range, Metric As Range, Qtr As Range) As Boolean
    Application.Volatile
        If Qtr.Value <> ThisQuarter Then Exit Function
        GetMissing = CompanyMetrics.IsMissing(Array(Company.Value, Metric.Value, Qtr.Value))
    End Function
    
    
    
    Public Function ThisQuarter()
    Select Case Month(Now)
        Case Is <= 3: ThisQuarter = "Q1" & Format(Now, "yy")
        Case Is <= 6: ThisQuarter = "Q2" & Format(Now, "yy")
        Case Is <= 9: ThisQuarter = "Q3" & Format(Now, "yy")
        Case Is <= 12: ThisQuarter = "Q4" & Format(Now, "yy")
    End Select
    End Function
    Public Function in Module CompanyMetrics:
    Option Explicit
    
    Public Function IsMissing(Inputs) As Boolean
    Dim Company As String
    Dim Metric As String
    Dim MetricRow As Range
    Dim Qtr As String
    Dim QtrColumn As Range
    Dim RO As Long 'Row Offset
    
        Company = Inputs(LBound(Inputs))
        Metric = Inputs(LBound(Inputs) + 1)
        Qtr = Inputs(LBound(Inputs) + 2)
        
        Select Case Metric
            Case Is = "Revenue": RO = 0
            Case Is = "Net Income": RO = 1
            Case Is = "EBITDA": RO = 2
            Case Is = "Debt": RO = 3
        End Select
    
        Set MetricRow = Range("A:A").Find(What:=Company, After:=Range("A1"), SearchOrder:=xlByRows).Offset(RO).EntireRow
        Set QtrColumn = Rows(1).Find(What:=Qtr, After:=Range("A1"), SearchOrder:=xlByColumns).EntireColumn
        
    IsMissing = Intersect(MetricRow, QtrColumn).Value = ""
    End Function
    Note that the yellow cel xxx in sheet 1 was added after I tested the code

    You can, of course use a single column in sheet1 and just change the Quarter designator at the top at each quarter
    Attached Files Attached Files
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  6. #6
    Thank you so much, I really appreciate that. You guys are life-savers on here.

  7. #7
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,879
    Location
    I'll leave the formatting and sorting up to you


    Option Explicit
    
    
    Sub FindMissingData()
        Dim rData As Range, rCell As Range
        Dim wsData As Worksheet, wsMissing As Worksheet
        Dim bAllData As Boolean
        Dim sQtr As String
        Dim iOut As Long, iLastCol As Long, iRow As Long, iCol As Long
        
        'format current quarter
        Select Case Month(Now)
            Case 1, 2, 3
                sQtr = "Q1" & Format(Now, "yy")
            Case 4, 5, 6
                sQtr = "Q2" & Format(Now, "yy")
            Case 7, 8, 9
                sQtr = "Q3" & Format(Now, "yy")
            Case 10, 11, 12
                sQtr = "Q4" & Format(Now, "yy")
        End Select
        
        
        'figure out what user wants to do
        If MsgBox("Look for missing data through " & sQtr & "?", vbQuestion + vbYesNo + vbDefaultButton2, "Look For Missing Data") = vbNo Then Exit Sub
        
        If MsgBox("Include non-missing data as well?", vbQuestion + vbYesNo + vbDefaultButton1, "Look For Missing Data") = vbYes Then
            bAllData = True
        Else
            bAllData = False
        End If
        
        'set some objects
        Set wsData = Worksheets("RawData")
        Set wsMissing = Worksheets("MissingData")
        Set rData = wsData.Cells(1, 1).CurrentRegion
        
        Application.ScreenUpdating = False
        
        'clear old data
        With wsMissing
            .Cells(2, 1).Resize(.Rows.Count - 1, 1).EntireRow.Delete
        End With
        
        For iLastCol = 3 To rData.Columns.Count
            If wsData.Cells(1, iLastCol).Value = sQtr Then Exit For
        Next iLastCol
        
        'move data from RawData to MissingData
        iOut = 1
        
        With rData
            For iRow = 2 To rData.Rows.Count
                For iCol = 3 To iLastCol
                    If bAllData Then
                        iOut = iOut + 1
                        wsMissing.Cells(iOut, 1).Value = wsData.Cells(iRow, 1).Value
                        wsMissing.Cells(iOut, 2).Value = wsData.Cells(iRow, 2).Value
                        wsMissing.Cells(iOut, 3).Value = wsData.Cells(1, iCol).Value
                        
                        If Len(Trim(wsData.Cells(iRow, iCol).Value)) = 0 Then
                            wsMissing.Cells(iOut, 4).Value = "Missing"
                        Else
                            wsMissing.Cells(iOut, 4).Value = wsData.Cells(iRow, iCol).Value
                        End If
                    
                    ElseIf Len(Trim(wsData.Cells(iRow, iCol).Value)) = 0 Then
                        iOut = iOut + 1
                        wsMissing.Cells(iOut, 1).Value = wsData.Cells(iRow, 1).Value
                        wsMissing.Cells(iOut, 2).Value = wsData.Cells(iRow, 2).Value
                        wsMissing.Cells(iOut, 3).Value = wsData.Cells(1, iCol).Value
                        wsMissing.Cells(iOut, 4).Value = "Missing"
                    End If
        
                Next iCol
            Next iRow
        End With
    
    
        Application.ScreenUpdating = True
    
    
    
    
        Call MsgBox("All Done", vbInformation + vbOKOnly, "Look For Missing Data")
    
    
    
    
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •