Solved

Excel VBA to get cell value of intersection between two strings with unstable row

Posted on 2011-02-23
4
1,081 Views
Last Modified: 2012-05-11
I am looking for a VBA code for the following task:

1) code to be started from ActiveWorkbook (dim wb1 as Workbook, wb1 = ActiveWorkbook)
2) check if more than two workbooks open - if yes MsgBox("You cannot have more than two workbooks open!") and exit, otherwise proceed to 3)
3) from the first sheet - Sheets(1) of the other open workbook (wb2), get the value from the cell where the string "Total Amount" in the first column of the sheet intersects with "Location Lease". The string "Location Lease" appears only once on the sheet, but not always in the same row (as I need to do this with a few dozen sheets) usually between row 3 and 10.
4) write the value from 3 to the wb1.ActiveCell and the name of the workbook one cell offset to the right.
5) Close wb2 without saving changes and exit

Thanks for your help!
0
Comment
Question by:BrdgBldr
  • 2
  • 2
4 Comments
 
LVL 10

Expert Comment

by:answer_dude
ID: 34965668
This should work.  Put this code in workbook 1 and run it.
Option Explicit

Sub WorkBookCheck()


    If Application.Workbooks.Count > 2 Then
        MsgBox ("You cannot have more than two workbooks open!")
        Exit Sub
    End If
    
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim wb As Workbook
    Dim nRow As Integer
    
    Set wb1 = Application.ActiveWorkbook
    
    For Each wb In Application.Workbooks
    
        If wb.Name <> wb1.Name Then
            Set wb2 = wb
        End If
    
    Next wb

    wb2.Activate
    nRow = FindLocationLeaseRow()
    If nRow = 0 Then
        MsgBox "Location Lease Not Found in " & ActiveWorkbook.Name
        Exit Sub
    End If
    wb1.Activate
    ActiveCell.Offset(0, 1) = wb2.Sheets(1).Cells(nRow, 1)
    
    wb2.Close SaveChanges:=False
    
End Sub

Function FindLocationLeaseRow()

On Error Resume Next

    FindLocationLeaseRow = 0
    If WorksheetFunction.CountA(Cells) > 0 Then
        'Search for entry, by searching backwards by Rows.
        FindLocationLeaseRow = Cells.Find(What:="Location Lease", After:=[A1], _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious).Row
    End If



End Function

Open in new window

0
 

Author Comment

by:BrdgBldr
ID: 34965738
Thanks answer dude. I think we are pretty close. However I can't see where we search for the row that has "Total Amount" in the first column. Maybe I did not write understandably in my question:

-"Location Lease" is a column heading, it is in the 4th to 7th column of the sheet, generally in the third to tenth row, so for example in E4, consequently E as column (or 5th column) for this example

-"Total Amount" is always in the first column (A), row not fixed, for example A31, consequently row 31 for this example

So in this case we need to fetch the value in E31 (intersection of E4 and A31)
0
 
LVL 10

Accepted Solution

by:
answer_dude earned 500 total points
ID: 34965961
Ok, so you want the column where location lease is the column heading and the row where total amount is the row heading.

I've updated it to the code below... I've cleaned it up a little, removed the function call... but you should be good.
Option Explicit

Sub WorkBookCheck()

    '
    If Application.Workbooks.Count <> 2 Then
        MsgBox ("You must have only two workbooks open!")
        Exit Sub
    End If
    
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim wb As Workbook
    Dim nRow As Integer
    Dim nColumn As Integer
    
    Set wb1 = Application.ActiveWorkbook
    
    For Each wb In Application.Workbooks
        If wb.Name <> wb1.Name Then
            Set wb2 = wb
        End If
    Next wb

    On Error Resume Next
    nRow = 0
    nRow = wb2.Sheets(1).Cells.Find(What:="Total Amount", After:=[A1], _
                  SearchOrder:=xlByRows, _
                  SearchDirection:=xlPrevious).Row
                  
    nColumn = 0
    nColumn = wb2.Sheets(1).Cells.Find(What:="Location Lease", After:=[IV1], _
                         SearchOrder:=xlByColumns, _
                         SearchDirection:=xlPrevious).Column

                  
    On Error GoTo 0
    
    If nRow = 0 Then
        MsgBox "Total Amount row not Found in " & wb2.Name
        Exit Sub
    End If
    If nColumn = 0 Then
        MsgBox "Location Lease column not Found in " & wb2.Name
        Exit Sub
    End If
    
    ActiveCell.Offset(0, 1) = wb2.Sheets(1).Cells(nRow, nColumn)
    wb2.Close SaveChanges:=False
    
End Sub

Open in new window

0
 

Author Closing Comment

by:BrdgBldr
ID: 34966119
Perfect solution. Works flawless. Many appreciated thanks and congratulations for the great work!
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Dealing with unintended Excel Active-X resizing quirks (VBA code simulates "self correction") David Miller (dlmille) Intro Not everyone is a fan of Active-X controls in spreadsheets (as opposed to the UserForm approach, the older Form controls …
INDEX and MATCH can be used to great effect to replace HLOOKUP and VLOOKUP as it does not have the limitation of needing the data to be sorted so that the reference value is in the first column or row. It also has the ability to perform a bi-directi…
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now