Announcement

Collapse
No announcement yet.

$20 criteria based cell value mining

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • $20 criteria based cell value mining

    Transaction ID 9ER81602AN76812D

    Click image for larger version

Name:	easy1.jpg
Views:	1
Size:	25.5 KB
ID:	1157537
    The table on the left is dynamic and not fixed to number of rows or columns. The table on the right is equally dynamic. (Note file locations are server located not on C drive).
    The column names will vary in length i.e 'Thomas Green 12' instead of just 'A'.
    Task is by selecting any value cell in the table on the left, will trigger some type of vlookup based on the column title in the table on the right, to open the relevant file location, AND highlight a particular cell based on both column name in table one and row title in table one. (don't assume the table one is starting from column A in the excel sheet it could be anywhere)

  • #2
    Re: $20 criteria based cell value mining

    Hi

    I could do that for you.
    In the file that should be opened, is it always the first sheet ?
    Also in that file, where do we look for the column name and the row name (resp, in row 1 and column A) ?
    Regards,

    Wigi

    Excel MVP 2011-2014

    For more Excel memes: visit http://www.wimgielis.com ==> English articles ==> Excel memes

    -- Topics without [CODE] tags or a meaningful topic title, will be neglected by me (and probably many others as well) --

    Comment


    • #3
      Re: $20 criteria based cell value mining

      Hi, Thank you, its not necessarily the first sheet. I'm happy to hard code the tab name into the vba. So if you could use 'tabNameGoesHere' or similar I could change it later.
      The row name can be found always in the second column(but would be good to have this finding logic running off of another column with the column number entered manually, added to the second table in above example). The column name may or not be in the third column so again having a column for this logic to be based on would work perfectly fine. Having this dynamic code makes it easier to adjust later.

      Comment


      • #4
        Re: $20 criteria based cell value mining

        Click image for larger version

Name:	newkey.JPG
Views:	1
Size:	34.8 KB
ID:	1127901As shown in this diagram.

        Comment


        • #5
          Re: $20 criteria based cell value mining

          That's good. I will assume that the second table (the one on the right) contains 4 columns: 2 just as now, then the rowname, then the column name.
          I will work on this. Basically, I will use "On Error Resume Next" and show a msgbox in case an error occurs. It will be more work to add descriptive error messages for everything that could go wrong
          (like names that are not found, the file does not exist, the cell that you select is empty, and so on). If wanted we could do that later on in a separate project. 18USD is fine for this exercise with 'basic' error handling.
          Regards,

          Wigi

          Excel MVP 2011-2014

          For more Excel memes: visit http://www.wimgielis.com ==> English articles ==> Excel memes

          -- Topics without [CODE] tags or a meaningful topic title, will be neglected by me (and probably many others as well) --

          Comment


          • #6
            Re: $20 criteria based cell value mining

            That's good. Like you showed, I will assume that the second table (the one on the right) contains 4 columns: 2 just as now, then the rowname, then the column name.
            I will work on this. Basically, I will use "On Error Resume Next" and show a msgbox in case an error occurs. It will be more work to add descriptive error messages for everything that could go wrong
            (like names that are not found, the file does not exist, the cell that you select is empty, and so on). If wanted we could do that later on in a separate project. 18USD is fine for this exercise with 'basic' error handling.
            Regards,

            Wigi

            Excel MVP 2011-2014

            For more Excel memes: visit http://www.wimgielis.com ==> English articles ==> Excel memes

            -- Topics without [CODE] tags or a meaningful topic title, will be neglected by me (and probably many others as well) --

            Comment


            • #7
              Re: $20 criteria based cell value mining

              ok sounds fair.

              Comment


              • #8
                Re: $20 criteria based cell value mining

                Hello,

                I wrote the code. Will you test it please ? That will be more efficient than sending files and me testing it from a technical perspective only, and on my PC.

                Code:
                Sub FindCell()
                
                    '============================================================
                    'Adjust to match
                    '
                    Const sStartingCell_TableOnTheRight As String = "AA3"    'the address of the cell in the upperleft corner
                    Const tabNameGoesHere     As String = "tab name"
                    '
                    '============================================================
                
                    Dim rCell_Selection       As Range
                    Dim rCell_Table2          As Range
                    Dim rCell_Target          As Range
                    Dim sColumnName           As String
                    Dim sRowName              As String
                    Dim sFileName             As String
                    Dim ws                    As Worksheet
                
                    On Error GoTo FindCell_Error
                
                    Set rCell_Selection = Selection.Cells(1)
                
                    sColumnName = Application.Intersect(rCell_Selection.EntireColumn, rCell_Selection.CurrentRegion.Rows(1))
                    sRowName = Application.Intersect(rCell_Selection.EntireRow, rCell_Selection.CurrentRegion.Columns(1))
                
                    Set rCell_Table2 = Range(sStartingCell_TableOnTheRight).CurrentRegion.Columns(1).Find(rCell_Selection.Text, , xlValues, xlWhole)
                    sFileName = rCell_Table2.Offset(, 1).Value
                
                    If Len(Dir(sFileName)) Then
                    
                        Set ws = Workbooks.Open(sFileName).Worksheets(tabNameGoesHere)
                
                        Set rCell_Target = ws.Cells( _
                                           ws.Columns(rCell_Table2.Offset(, 2).Value).Find(sRowName).Row, _
                                           ws.Columns(rCell_Table2.Offset(, 3).Value).Find(sColumnName).Column)
                
                        rCell_Target.Interior.ColorIndex = vbRed
                        Application.Goto rCell_Selection, True
                    
                    Else
                    
                        MsgBox "The target file (" & sFileName & ") could not be found. Please verify.", vbInformation
                
                    End If
                
                    On Error GoTo 0
                    Exit Sub
                
                FindCell_Error:
                
                    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FindCell of Module mFindCell"
                
                End Sub
                Last edited by Wigi; December 1st, 2016, 01:27. Reason: typo
                Regards,

                Wigi

                Excel MVP 2011-2014

                For more Excel memes: visit http://www.wimgielis.com ==> English articles ==> Excel memes

                -- Topics without [CODE] tags or a meaningful topic title, will be neglected by me (and probably many others as well) --

                Comment


                • #9
                  Re: $20 criteria based cell value mining

                  Hi Wigi, I have tested the code but cant seem to make this work at all. it seems to go wrong at the
                  Code:
                  Set rCell_Table2 = Range(sStartingCell_TableOnTheRight).CurrentRegion.Columns(1).Find(rCell_Selection.Text, , xlValues, xlWhole) 
                      sFileName = rCell_Table2.Offset(, 1).Value
                  part of the coding. I am guessing its because I have set it up incorrect as the values in this part of the code are empty. AA3 is the address in the cell of the top left corner of the second table? I think it would be better if I upload a better picture with cell values.Click image for larger version

Name:	Capture3.jpg
Views:	1
Size:	30.0 KB
ID:	1127906 Can you explain how to adjust this code with the attached picture showing cell markings? Thanks!

                  Comment


                  • #10
                    Re: $20 criteria based cell value mining

                    Hello there,

                    Updated coding, I changed AA3 to J3 based on your screenshot:

                    Code:
                    Sub FindCell()
                    
                         '============================================================
                         'Adjust to match
                         '
                        Const sStartingCell_TableOnTheRight As String = "J3" 'the address of the cell in the upperleft corner
                        Const tabNameGoesHere     As String = "tab name"
                         '
                         '============================================================
                    
                        Dim rCell_Selection       As Range
                        Dim rCell_Table2          As Range
                        Dim rCell_Target          As Range
                        Dim sColumnName           As String
                        Dim sRowName              As String
                        Dim sFileName             As String
                        Dim ws                    As Worksheet
                    
                        On Error Goto FindCell_Error
                    
                        Set rCell_Selection = Selection.Cells(1)
                    
                        sColumnName = Application.Intersect(rCell_Selection.EntireColumn, rCell_Selection.CurrentRegion.Rows(1))
                        sRowName = Application.Intersect(rCell_Selection.EntireRow, rCell_Selection.CurrentRegion.Columns(1))
                    
                        Set rCell_Table2 = Range(sStartingCell_TableOnTheRight).CurrentRegion.Columns(1).Find(sColumnName, , xlValues, xlWhole)
                        sFileName = rCell_Table2.Offset(, 1).Value
                    
                        If Len(Dir(sFileName)) Then
                    
                            Set ws = Workbooks.Open(sFileName).Worksheets(tabNameGoesHere)
                    
                            Set rCell_Target = ws.Cells( _
                            ws.Columns(rCell_Table2.Offset(, 2).Value).Find(sRowName).Row, _
                            ws.Columns(rCell_Table2.Offset(, 3).Value).Find(sColumnName).Column)
                    
                            rCell_Target.Interior.ColorIndex = vbRed
                            Application.Goto rCell_Selection, True
                    
                        Else
                    
                            MsgBox "The target file (" & sFileName & ") could not be found. Please verify.", vbInformation
                    
                        End If
                    
                        On Error Goto 0
                        Exit Sub
                    
                    FindCell_Error:
                    
                        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FindCell of Module mFindCell"
                    
                    End Sub
                    Regards,

                    Wigi

                    Excel MVP 2011-2014

                    For more Excel memes: visit http://www.wimgielis.com ==> English articles ==> Excel memes

                    -- Topics without [CODE] tags or a meaningful topic title, will be neglected by me (and probably many others as well) --

                    Comment


                    • #11
                      Re: $20 criteria based cell value mining

                      HappyChappy30,

                      Could you please test the code ? Any feedback and PayPal donation please ?

                      Wigi
                      Regards,

                      Wigi

                      Excel MVP 2011-2014

                      For more Excel memes: visit http://www.wimgielis.com ==> English articles ==> Excel memes

                      -- Topics without [CODE] tags or a meaningful topic title, will be neglected by me (and probably many others as well) --

                      Comment


                      • #12
                        Re: $20 criteria based cell value mining

                        Hi again, sorry Wigi I just realised the row number should be dependent on the first tables reference code and not the second tables row number column.

                        Comment


                        • #13
                          Re: $20 criteria based cell value mining

                          Hello

                          If I understand you correctly, please look at this part in the code:

                          Code:
                                  Set rCell_Target = ws.Cells( _ 
                                  ws.Columns(rCell_Table2.Offset(, 2).Value).Find(sRowName).Row, _ 
                                  ws.Columns(rCell_Table2.Offset(, 3).Value).Find(sColumnName).Column)
                          rCell_Table2 is the cell in the right table, first column. If we then do Offset = 2 and Offset = 3, then you jump 2 and 3 columns to the right.
                          2 for the row, 3 for the column.

                          Please change accordingly based on my explanation here.
                          Regards,

                          Wigi

                          Excel MVP 2011-2014

                          For more Excel memes: visit http://www.wimgielis.com ==> English articles ==> Excel memes

                          -- Topics without [CODE] tags or a meaningful topic title, will be neglected by me (and probably many others as well) --

                          Comment


                          • #14
                            Re: $20 criteria based cell value mining

                            Hi sorry I didn't explain clearly, its actually the row number is defined by the contents of the first column in the first table. i.e the column with the codes in.

                            so
                            Code:
                            ws.Columns(rCell_Table2.Offset(, 2).Value).Find(sRowName).Row, _
                            is based on the reference codes listed in the first table. Or put it another way, the row locations are defined by some type of vlookup of the reference codes in the first table which will match the codes on the workbook that will be opened.


                            Originally posted by Wigi View Post
                            Hello there,

                            Updated coding, I changed AA3 to J3 based on your screenshot:

                            Code:
                            Sub FindCell()
                            
                                 '============================================================
                                 'Adjust to match
                                 '
                                Const sStartingCell_TableOnTheRight As String = "J3" 'the address of the cell in the upperleft corner
                                Const tabNameGoesHere     As String = "tab name"
                                 '
                                 '============================================================
                            
                                Dim rCell_Selection       As Range
                                Dim rCell_Table2          As Range
                                Dim rCell_Target          As Range
                                Dim sColumnName           As String
                                Dim sRowName              As String
                                Dim sFileName             As String
                                Dim ws                    As Worksheet
                            
                                On Error Goto FindCell_Error
                            
                                Set rCell_Selection = Selection.Cells(1)
                            
                                sColumnName = Application.Intersect(rCell_Selection.EntireColumn, rCell_Selection.CurrentRegion.Rows(1))
                                sRowName = Application.Intersect(rCell_Selection.EntireRow, rCell_Selection.CurrentRegion.Columns(1))
                            
                                Set rCell_Table2 = Range(sStartingCell_TableOnTheRight).CurrentRegion.Columns(1).Find(sColumnName, , xlValues, xlWhole)
                                sFileName = rCell_Table2.Offset(, 1).Value
                            
                                If Len(Dir(sFileName)) Then
                            
                                    Set ws = Workbooks.Open(sFileName).Worksheets(tabNameGoesHere)
                            
                                    Set rCell_Target = ws.Cells( _
                                    ws.Columns(rCell_Table2.Offset(, 2).Value).Find(sRowName).Row, _
                                    ws.Columns(rCell_Table2.Offset(, 3).Value).Find(sColumnName).Column)
                            
                                    rCell_Target.Interior.ColorIndex = vbRed
                                    Application.Goto rCell_Selection, True
                            
                                Else
                            
                                    MsgBox "The target file (" & sFileName & ") could not be found. Please verify.", vbInformation
                            
                                End If
                            
                                On Error Goto 0
                                Exit Sub
                            
                            FindCell_Error:
                            
                                MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FindCell of Module mFindCell"
                            
                            End Sub

                            Comment


                            • #15
                              Re: $20 criteria based cell value mining

                              Hello,

                              Please provide correct and descriptive screenshots of your tables, and how the information can be located.

                              Also, please use F8 to step through the code and use the debugging tools in VBA to understand what the code is doing (or not).
                              Regards,

                              Wigi

                              Excel MVP 2011-2014

                              For more Excel memes: visit http://www.wimgielis.com ==> English articles ==> Excel memes

                              -- Topics without [CODE] tags or a meaningful topic title, will be neglected by me (and probably many others as well) --

                              Comment

                              Working...
                              X