سؤال

I am trying to build a sub that will enter a formula into a cell, filldown the vlookup formula to lastrow, then copy the formula and pastespecial->values for the entire range. The table I use in vLookup is located in a separate file that is not always stored in the same location. The Table is always formatted the same, but the table size is not always the same.

I have to do this on 4 different worksheets and the column that I have to enter this formula in has a heading of "Order Grade". I use a .Find to return the location of "Order Grade". I then want to enter my Vlookup 1 row below where "Order Grade" is found.

if I enter the formula manually on the worksheet it looks like this:

=VLOOKUP(C2,[newpipe.xlsx]Sheet1!$A$1:$B$376,2,FALSE)    

in VBA the formula I want to construct would look something like this:

=vlookup(RC[-1],stringFileName\[newpipe.xlsx]Sheet1!$A$1:LastColumn & LastRow,2,False

With the user choosing the stringFileName using an open file dialog box. LastColumn and LastRow on the chosen sheet should be calculated by the macro.

Here is what I have so far.

Private Function UseFileDialogOpen()
Dim myString As String
' Open the file dialog
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count = 1 Then
        myString = .SelectedItems(1)
        'MsgBox myString
        UseFileDialogOpen = myString
    Else
        MsgBox ("Failed to properly open file")
        myString = "fail"
        UseFileDialogOpen = myString
    End If
End With
End Function

Sub formatOrderColumn()
Dim strSearch
Dim foundColumn
Dim foundRow
Dim RowBelowSpotFound
Dim fileLocation

strSearch = "Order Grade"

Set aCell = ActiveSheet.Rows(1).Find(what:=strSearch, LookIn:=xlValues, _
Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)

If Not aCell Is Nothing Then
    foundColumn = aCell.Column
    foundRow = aCell.Row
    spotFound = ColumnLetter(foundColumn) & foundRow + 1
'    MsgBox "Value Found in Row " & foundRow & _
    " and the Column Number is " & foundColumn
Else
    Exit Sub
End If

fileLocation = UseFileDialogOpen()
LastColumn = FindLastColumn(UserSelectedSheet)
LastRow = FindLastRow(UserSelectedSheet)
Range(RowBelowSpotFound).Formula = _
    "=vlookup(RC[-1], [" & fileLocation & "]Sheet1!$A$1:" & LastColumn & lastrow & ",2,False"
End Sub

I do not know how to get the lastrow and lastColumn from the user chosen file. I have functions that do that for any Worksheet that is passed to them. I realize I did a pretty poor job explaining my situation and am not at all sure I am going about this the best way. If you have any questions let me know and I'll do my best to clarify. I'll be leaving the office soon so may not be able to reply until the morning.

Here is new formula. I get error on last line when I try to set the offset cell formula to the string value. The string value is correct. I get the same error if I try to set the cell value directly without using the mystring holder to first build the string. "application or object defined error"

Sub vlookupOrderGrade()

Dim strSearch
Dim fileLocation
Dim aCell As Range
Dim aCellString
Dim myString As String
strSearch = "Order Grade"

Set aCell = ActiveSheet.Rows(1).Find(what:=strSearch, LookIn:=xlValues, _
                                 Lookat:=xlWhole, MatchCase:=True)
If Not aCell Is Nothing Then
    fileLocation = UseFileDialogOpen()
    If fileLocation <> "fail" Then
        'replace last "\" with a "["
        fileLocation = StrReverse(fileLocation)
        fileLocation = Replace(fileLocation, "\", "[", 1, 1)
        fileLocation = StrReverse(fileLocation)
        'build string
        myString = "=vlookup(" & _
                     ColumnLetter(aCell.Column - 1) & aCell.Row + 1 & _
                     ", '" & fileLocation & "]Sheet1'!$A:$B,2,False"
        MsgBox (myString)
        'set cell to string
        aCell.Offset(1, 0).Formula = myString
    End If
Else
    Exit Sub
End If
End Sub
هل كانت مفيدة؟

المحلول

Untested:

Sub formatOrderColumn()

Dim strSearch
Dim fileLocation

strSearch = "Order Grade"

Set aCell = ActiveSheet.Rows(1).Find(what:=strSearch, LookIn:=xlValues, _
                                     Lookat:=xlWhole, MatchCase:=True)

    If Not aCell Is Nothing Then

        fileLocation = UseFileDialogOpen()
        If fileLocation <> "fail" Then

            aCell.Offset(1, 0).Formula = "=vlookup(" & _
                         aCell.Offset(1, -1).Address(False, False) & _
                         ", '[" & fileLocation & "]Sheet1'!$A:$B,2,False"
        End If
    Else
        Exit Sub
    End If

End Sub
مرخصة بموجب: CC-BY-SA مع الإسناد
لا تنتمي إلى StackOverflow
scroll top