We value your feedback.
Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!
Private Sub Exit_Click() Me.Hide End Sub Private Sub Open_Click() Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim strPath As String, strFile1 As String, strFile2 As String Dim wbkThis As Workbook, wbk1 As Workbook, wbk2 As Workbook Dim wksDest As Worksheet, wksSource As Worksheet, wksCheck As Worksheet Dim rngMatch As Range, rngCheck As Range, rngFound As Range, rngCopy As Range CommonDialog1.flags = cdlOFNExplorer Or cdlOFNLongNames CommonDialog1.FileName = "" CommonDialog1.Filter = "Excel Files (*.xls)|*.xls|" CommonDialog1.DialogTitle = "Browse for file" CommonDialog1.ShowOpen Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True Set xlBook = xlApp.Workbooks.Open(CommonDialog1.FileName) Set wbkThis = Workbooks.Add Set wbk1 = xlBook Set wbk2 = Excel.Workbooks.Open("c:\Users\User1.xls") 'Change sheet names as required ' This is the sheet to copy to Set wksDest = wbkThis.Sheets("Sheet1") ' This is the sheet in XLS1 Set wksSource = wbk1.Sheets(1) Set wksCheck = wbk2.Sheets(1) ' Get first blank row in main workbook to copy to With wksDest Set rngCopy = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) End With ' First cell to check in XLS1 Set rngMatch = wksSource.Range("D1") ' Set check range to all used cells in column A of XLS2 With wksCheck Set rngCheck = wksCheck.Range("a2") 'Set rngCheck = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) End With ' Loop through cells in column A of XLS1 until a blank cell is encountered Do Until Len(rngMatch.value) = 0 Set rngFound = rngCheck.Find(what:=rngMatch.value, LookIn:=xlValues, lookat:=xlWhole) If Not rngFound Is Nothing Then ' Copy data from XLS2 to this workbook rngFound.Copy rngCopy Set rngCopy = rngCopy.Offset(1, 0) End If Set rngMatch = rngMatch.Offset(1, 0) Loop wbk1.Close False wbk2.Close False wbkThis.Save End Sub
Join the community of 500,000 technology professionals and ask your questions.