Post data from one workbook to a different closed workbook in VBA

[ColinCoady]

The following code works great in posting data from one workbook to another but it posts to the last open row. Which was fine at the time but now I want it to do something different. The 1st column in the closed workbook (QuoteListing.xlsx) has unique data in it already and I want to find the row that matches the criteria from the workbook I'm working in(Tenant Billing.xlsm) and post data into the 2nd to 5th columns.
Can I get some help with making it work. The criteria is in cell B4 and that value will match on 1 cell only in the data in Column A in the closed workbook.

Here is my current code

Private Sub CommandButton1_Click()
Dim itemDate As String
Dim itemShortDsc As String
Dim myData As Workbook


Worksheets("InfoEntry").Select
itemDate = Range("B3")
itemShortDsc = Range("B13")
itemProperty = Range("B6")
itemTenant = Range("B7")


Set myData = Workbooks.Open("C:\USERS\ccoady\Desktop\Tenant Billing\QuoteListing.xlsx")
Worksheets("QList").Select
Worksheets("QList").Range("B1").Select
RowCount = Worksheets("Qlist").Cells(Rows.Count, 2).End(xlUp).Row
With Worksheets("QList").Range("B1")
.Offset(RowCount, 0) = itemProperty
.Offset(RowCount, 1) = itemTenant
.Offset(RowCount, 2) = itemShortDsc
.Offset(RowCount, 3) = itemDate


End With
myData.Save
myData.Close


End Sub

 

[mumps]

Try:

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim itemDate As Range, itemShortDsc As Range, itemProperty As Range, itemTenant As Range, myData As Workbook, fnd As Range, searchVal As Range
    With Worksheets("InfoEntry")
        Set searchVal = .Range("B4")
        Set itemDate = .Range("B3")
        Set itemShortDsc = .Range("B13")
        Set itemProperty = .Range("B6")
        Set itemTenant = .Range("B7")
    End With
    Set myData = Workbooks.Open("C:\USERS\ccoady\Desktop\Tenant Billing\QuoteListing.xlsx")
    Set fnd = Sheets("Qlist").Range("A:A").Find(searchVal, LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd Is Nothing Then
        With fnd
            .Offset(0, 1) = itemProperty
            .Offset(0, 2) = itemTenant
            .Offset(0, 3) = itemShortDsc
            .Offset(0, 4) = itemDate
        End With
    End If
    myData.Close True
    Application.ScreenUpdating = True
End Sub

 

[ColinCoady]

Works wonderfully - thank you so much.

What can I use to automatically put in the USERS correct name (ccoady now) when I copy the workbooks onto another computer but still using \Desktop\Tenant Billing\ folders on the new computer?

Thanks again Mumps
-Colin

 

[mumps]

You are very welcome.
Replace this line of code:

 Set myData = Workbooks.Open("C:\USERS\ccoady\Desktop\Tenant Billing\QuoteListing.xlsx")

with this line:

Set myData = Workbooks.Open(CreateObject("WScript.Shell").specialfolders("Desktop") & "\Tenant Billing\QuoteListing.xlsx")

 

[Fluff]

Another way

Set myData = Workbooks.Open(environ("userprofile") &"\Desktop\Tenant Billing\QuoteListing.xlsx")