Loading
Ozgrid Excel Help & Best Practices Forums

Excel Training / Excel Dashboards Reports



Page 2 of 4 FirstFirst 1 2 3 4 LastLast
Results 11 to 20 of 32

Thread: $20 criteria based cell value mining

  1. #11
    Join Date
    15th August 2005
    Location
    Mechelen, Belgium
    Posts
    6,301

    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) --

  2. #12
    Join Date
    27th May 2011
    Posts
    57

    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.

  3. #13
    Join Date
    15th August 2005
    Location
    Mechelen, Belgium
    Posts
    6,301

    Re: $20 criteria based cell value mining

    Hello

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

    VB:
    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) --

  4. #14
    Join Date
    27th May 2011
    Posts
    57

    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
    VB:
    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.


    Quote Originally Posted by Wigi View Post
    Hello there,

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

    VB:
    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 
    
    

  5. #15
    Join Date
    15th August 2005
    Location
    Mechelen, Belgium
    Posts
    6,301

    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) --

  6. #16
    Join Date
    27th May 2011
    Posts
    57

    Re: $20 criteria based cell value mining

    Hi Wigi, Thank you for your help.

    I am happy to add an additional $20 for the error handling description you mentioned earlier once we get this up and running.
    Here is a better description, I added the improved description in red to the existing one.

    Capture5.jpg

    note the two tables are on separate tabs. So the missing part to the code is some type of Vlookup of the first table offsetting to the value defined in the second tables column reference.




    Quote Originally Posted by Wigi View Post
    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).

  7. #17
    Join Date
    27th May 2011
    Posts
    57

    Re: $20 criteria based cell value mining

    Here is the transaction id for the second $20 transaction (10% to ozgrid deposit) ID 7NT72648YG034101F
    Thanks!

  8. #18
    Join Date
    27th May 2011
    Posts
    57

    Re: $20 criteria based cell value mining

    Can anyone help with this?

  9. #19
    Join Date
    15th August 2005
    Location
    Mechelen, Belgium
    Posts
    6,301

    Re: $20 criteria based cell value mining

    Hello,

    Over the weekend I will do the code for the first part.
    If possible also the second part. I will keep you posted.
    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) --

  10. #20
    Join Date
    15th August 2005
    Location
    Mechelen, Belgium
    Posts
    6,301

    Re: $20 criteria based cell value mining

    Hello there,

    Here's updated coding, also with extensive error handling. Can you test it please and provide feedback, as well as transfer the funds ? Thanks !

    VB:
    Sub FindCell() 
         
         '============================================================
         'Adjust to match
         '
        Const sTabNameForSecondTable = "sheet2" 'the name of the sheet where table 2 is located
        Const sStartingCell_TableOnTheRight As String = "J3" 'the address of the cell in the upperleft corner for table 2
        Const tabNameGoesHere     As String = "tab name" 'the sheet name where the cursor will land
         '
         '============================================================
         
        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 
        Dim lRow                  As Long 
        Dim lColumn               As Long 
         
        If SheetExists(sTabNameForSecondTable) = False Then 
            MsgBox "The sheet called '" & sTabNameForSecondTable & "' does not exist in the active workbook.", vbCritical 
            Exit Sub 
        End If 
         
        Set rCell_Selection = Selection.Cells(1) 
         
        sColumnName = Trim(Application.Intersect(rCell_Selection.EntireColumn, rCell_Selection.CurrentRegion.Rows(1))) 
        If sColumnName = "" Then 
            MsgBox "The column name for the selected cell (" & rCell_Selection.Address(0, 0) & ") is empty.", vbCritical 
            Exit Sub 
        End If 
         
        sRowName = Trim(Application.Intersect(rCell_Selection.EntireRow, rCell_Selection.CurrentRegion.Columns(1))) 
        If sRowName = "" Then 
            MsgBox "The row name for the selected cell (" & rCell_Selection.Address(0, 0) & ") is empty.", vbCritical 
            Exit Sub 
        End If 
         
        On Error Resume Next 
        Set rCell_Table2 = Worksheets(sTabNameForSecondTable).Range(sStartingCell_TableOnTheRight).CurrentRegion.Columns(1).Find(sColumnName, , xlValues, xlWhole) 
        On Error Goto 0 
         
        If rCell_Table2 Is Nothing Then 
            MsgBox "In table 2, first column, we could not find '" & sColumnName & "'. That first column's address is " & _ 
            Range(sStartingCell_TableOnTheRight).CurrentRegion.Columns(1).Address(0, 0), vbCritical 
            Exit Sub 
        End If 
        sFileName = rCell_Table2.Offset(, 1).Value 
        If Len(Dir(sFileName)) = 0 Then 
             
            MsgBox "The target file '" & sFileName & "' could not be found. Please verify.", vbCritical 
            Exit Sub 
             
        Else 
             
            On Error Resume Next 
            Set ws = Workbooks.Open(sFileName).Worksheets(tabNameGoesHere) 
            On Error Goto 0 
             
            If ws Is Nothing Then 
                MsgBox "The sheet called '" & tabNameGoesHere & "' could not be accessed.", vbCritical 
                Exit Sub 
            End If 
             
            On Error Resume Next 
            lRow = ws.Columns(1).Find(sRowName).Row 
            On Error Goto 0 
             
            If lRow = 0 Then 
                MsgBox "The desired row could not be found. In column A of the target worksheet we did a Find of '" & sRowName & "'.", vbCritical 
                Exit Sub 
            End If 
             
            On Error Resume Next 
            lColumn = rCell_Table2.Offset(, 2).Value 
            On Error Goto 0 
             
            If lColumn = 0 Then 
                MsgBox "The desired column could not be found. To know the column offset (offset starting in column B of target worksheet) " & _ 
                "we looked at the 3rd column of table 2.", vbCritical 
                Exit Sub 
            End If 
             
            On Error Resume Next 
            Set rCell_Target = ws.Cells(lRow, 2).Offset(, lColumn) 
            On Error Goto 0 
             
            If rCell_Target Is Nothing Then 
                MsgBox "The desired cell could not be accessed. We tried row = " & lRow & ", column = " & lColumn, vbCritical 
                Exit Sub 
            End If 
             
            On Error Resume Next 
            rCell_Target.Interior.ColorIndex = 19 
            Application.Goto rCell_Target, True 
            If Err.Number <> 0 Then 
                Err.Clear 
                On Error Goto 0 
                MsgBox "The desired cell '" & rCell_Target.Address(0, 0) & "' could not be accessed or highlighted in pink.", vbCritical 
                Exit Sub 
            End If 
             
        End If 
         
    End Sub 
     
    Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean 
         
        Dim sht                   As Worksheet 
         
        If wb Is Nothing Then Set wb = ActiveWorkbook 
        On Error Resume Next 
        Set sht = wb.Sheets(shtName) 
        On Error Goto 0 
        SheetExists = Not sht Is Nothing 
         
    End Function 
    
    
    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) --

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Possible Answers

  1. Automatic Data Mining and Word Counts
    By starkman in forum Excel General
    Replies: 1
    Last Post: July 19th, 2011, 02:38
  2. Re: Text Mining in large database
    By apassala in forum Excel General
    Replies: 1
    Last Post: October 10th, 2010, 21:35
  3. Data Mining Multiple Workbooks
    By matrix01 in forum Excel General
    Replies: 4
    Last Post: January 10th, 2008, 06:07
  4. Text Mining in large database
    By JoshuaJ in forum Excel General
    Replies: 2
    Last Post: March 29th, 2006, 08:31

Bookmarks

Posting Permissions

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