Solved

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

Posted on 2011-02-23
4
1,088 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Drop Down List with Unique/Distinct Values (Part II - ComboBox or ListBox and Data Validation List Bonus!) David Miller (dlmille) Intro This article focuses on delivering unique, sorted lists to list objects (e.g., ComboBox, ListBox) and Dat…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

937 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

9 Experts available now in Live!

Get 1:1 Help Now