Source column contains a string in each cell. There are 4000+ cells. These need to be copied and pasted into a worksheet of the active (one that invoked the macro) workbook. Source workbook should be selected by the user using a search/browse pop-up box.
Code below does something close to my intended goal but...the directory as you see is static which is unacceptable. Maximum flexibility should be had with user choosing the source file manually. Furthermore, I want to prevent the file path from becoming obsolete every time folders/files get renamed/shifted. Something tell me " Application.GetOpenFilename() " should be used. But how to correctly implement it?
Having little experience with the VBA, my attempts to mod this macro failed. So I am asking for your help/advice on the matter. Again, code below works well but its not flexible enough to be practical. Thanks guys! :)
EDIT: Problem solved! See final, working code. Hope it's of some use to programmers out there. :)
'MACRO TO READ-IN EXTERNAL EXCEL FILE FROM WHICH JOB NO.'S ARE EXTRACTED INTO USERFORM Sub ReadDataFromCloseFile()
'IN CASE OF ERROR SEND TO ERROR FUNCTION
On Error GoTo ErrHandler
'PREVENT OPENED EXCEL SOURCE FILE FROM SHOWING TO USER
Application.ScreenUpdating = False
'OPEN SOURCE EXCEL WORKBOOK IN "READ ONLY MODE"
Dim SrcName As String
Dim src As Workbook
SrcName = Application.GetOpenFilename()
Set src = Workbooks.Open(SrcName, True, True)
'GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK
Dim iTotalRows As Integer
iTotalRows = src.Worksheets("PROJECT LIST").Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Rows.Count
'COPY DATA FROM SOURCE WORKBOOK -> DESTINATION WORKBOOK
Dim iCnt As Integer '(COUNTER)
For iCnt = 1 To iTotalRows
Worksheets("Test_File_8").Range("B" & (iCnt + 1)).Formula = src.Worksheets("PROJECT LIST").Range("A" & (iCnt + 1)).Formula
Next iCnt
'CLOSE THE SOURCE WORKBOOK FILE
src.Close False 'FALSE = DONT SAVE THE SOURCE FILE
Set src = Nothing 'FLUSH DATA
'ERROR FUNCTION
ErrHandler: Application.EnableEvents = True Application.ScreenUpdating = True End Sub
See my changes below. I added two variables X
and strSrc
. X
is a variant that is used to loop through .SelectedItems
and strSrc
is that string that ultimately holds the path.
Sub ReadDataFromCloseFile()
'Set variable to hold workbook path and workbook path string
Dim X as Variant
Dim strSrc as String
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = "" ' You can provide a base path here
.Title = "Select file."
.AllowMultiSelect = False
If .Show = -1 Then
For Each X In .SelectedItems
strSrc = X
Exit For
Next X
End If
End With
'IN CASE OF ERROR SEND TO ERROR FUNCTION
'On Error GoTo ErrHandler
'PREVENT OPENED EXCEL SOURCE FILE FROM SHOWING TO USER
Application.ScreenUpdating = False
'OPEN SOURCE EXCEL WORKBOOK IN "READ ONLY MODE"
Dim src As Workbook
Set src = Workbooks.Open(strSrc, True, True)
'GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK
Dim iTotalRows As Integer
iTotalRows = src.Worksheets("PROJECT LIST").Range("A1:A" & src.Worksheets("PROJECT LIST").Cells(Rows.Count, "A").End(xlUp).Row).Rows.Count
'COPY DATA FROM SOURCE WORKBOOK -> DESTINATION WORKBOOK
Dim iCnt As Integer '(COUNTER)
For iCnt = 1 To iTotalRows
src.Worksheets("Test_File_8").Range("B" & (iCnt + 1)).Formula = src.Worksheets("PROJECT LIST").Range("A" & (iCnt + 1)).Formula
Next iCnt
'CLOSE THE SOURCE WORKBOOK FILE
src.Close False 'FALSE = DONT SAVE THE SOURCE FILE
Set src = Nothing 'FLUSH DATA
'ERROR FUNCTION
ErrHandler: Application.EnableEvents = True Application.ScreenUpdating = True End Sub
'MACRO TO READ-IN EXTERNAL EXCEL FILE FROM WHICH JOB NO.'S ARE EXTRACTED INTO USERFORM
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.