By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,853 Members | 1,034 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,853 IT Pros & Developers. It's quick & easy.

[Excel/VBA ] How to Find and copy data(Mapped data) from another worksheet using VBA?

P: 36
Hi all,

I am new to Excel/VBA and would require your help.
I have stuck again somewhere and will be highly obliged if you can help me.

I have two worksheet
1. Import File Utility (Sheet A)
2. TeamCenterVsFileMapping (Sheet B)

In Sheet A there are five columns(File Path, File Type, Dataset Type, Dataset Name, Named Reference) and "Import" button. if user clicks on Import button and select any folder, then Filepath, Filetype, Dataset Name(i.e Filename) corresponding to all files are imported in the Sheet A's Cells. But i also need to import values corresponding to Dataset Type and Named Reference. These values are fetching from Sheet B i.e TeamCenterVsFileMapping.
There is a mapping of Filetype Vs Dataset Type Vs Named Reference in Sheet B just like:


FileType ---- DatasetType ---- NamedReference
------------------------------------------------
zip ---- zipAddress ---- MScompression
accdb ---- Access ---- MSAccess
jpeg ---- Image ---- Xyz
jpg ---- Image ---- XXX
pdf ---- Acrobat ---- YYY


No what i want for each filetype in Sheet A, it will search File Type in Sheet B and if it finds then copy the Dataset Type and Named Reference value from Sheet B to Sheet A.

i have been able to do it but its:
1. When i import files, these two values are not getting imported for all files (but for few files they are getting imported).
2. However if i import same folder second time then all fields and their value are getting imported.
See the code below
Expand|Select|Wrap|Line Numbers
  1. Sub GetFileList()
  2. ChDrive "M"
  3. ChDir "M:\Certificates"
  4.      'Const cStartRow As Long = 2
  5.      Const cFPathCol As Long = 1
  6.      Const cExtentionCol As Long = 2
  7.      Const cDatasetType As Long = 3
  8.      Const cFNameCol As Long = 4
  9.      Const cNamedReference As Long = 5
  10.      Const cLog As Long = 6
  11.  
  12.      Dim ThisFolder As String
  13.      Dim ThisFile As String
  14.      Dim FileName As String
  15.      Dim Extention As String
  16.      Dim i As Long
  17.  
  18.     If SelectDirectoryOK(ThisFolder) Then
  19.          ThisFile = Dir(ThisFolder & "\*.*")
  20.          i = Cells(50000, cFPathCol).End(xlUp).Offset(1, 0).Row
  21.          'i = cStartRow
  22.          Do Until ThisFile = ""
  23.  
  24.              FileName = Left(ThisFile, InStrRev(ThisFile, ".") - 1)
  25.              Extention = Mid(ThisFile, InStrRev(ThisFile, ".") + 1)
  26.  
  27.              Cells(i, cFPathCol) = ThisFolder & "\" & FileName & "." & Extention
  28.              Cells(i, cExtentionCol) = Extention
  29.              Cells(i, cFNameCol) = FileName
  30.              Call CopyTeamCentreValue(Extention, i)
  31.              'Cells(i, cDatasetType) = DataSetValue(Extention, i)
  32.              'Cells(i, cNamedReference) = NamedReferenceFunction(Extention)
  33.              Cells(i, cLog) = "import.log"
  34.              i = i + 1
  35.              ThisFile = Dir
  36.          Loop
  37.     End If
  38. End Sub
  39.  
  40.  Function SelectDirectoryOK(ByRef Directory As String, Optional InitialPath As String = "") As Boolean
  41.      SelectDirectoryOK = False
  42.  
  43.      With Application.FileDialog(msoFileDialogFolderPicker)
  44.          If InitialPath <> "" Then .InitialFileName = InitialPath
  45.          .Title = "Select File FOLDER"
  46.          .AllowMultiSelect = False
  47.          .Show
  48.          If .SelectedItems.Count = 0 Then Exit Function
  49.          Directory = .SelectedItems(1)
  50.      End With
  51.  
  52.      SelectDirectoryOK = True
  53.  End Function
  54.  
  55. Sub CopyTeamCentreValue(Extention As String, i As Long)
  56.   'Copy cells of cols A,F,E,D from rows containing "Significant" in
  57.   'col D of the active worksheet (source sheet) to cols
  58.   'A,B,C,D of Sheet2 (destination sheet)
  59.   Dim DestSheet As Worksheet
  60.   Const cDatasetType As Long = 3
  61.   Const cNamedReference As Long = 5
  62.   Dim SourceSheet As Worksheet
  63.   Set DestSheet = Worksheets("Import File Utility")
  64.   Set SourceSheet = Worksheets("TeamCenterVsFileMapping")
  65.  
  66.   Dim sRow As Long     'row index on source worksheet
  67.   Dim dRow As Long     'row index on destination worksheet
  68.   Dim sCount As Long
  69.   dRow = i
  70.   For sRow = 2 To Range("A65536").End(xlUp).Row
  71.      'use pattern matching to find "File Type" anywhere in cell
  72.      If SourceSheet.Cells(sRow, "A") = Extention Then
  73.         'copy cols A,F,E & D
  74.          'SourceSheet.Cells(sRow, "B").Copy Destination:=DestSheet.Cells(dRow, cDatasetType)
  75.         DestSheet.Cells(dRow, cDatasetType) = SourceSheet.Cells(sRow, "B")
  76.         'DestSheet.Cells(i, cNamedReference) = SourceSheet.Cells(sRow, "C")
  77.      End If
  78.   Next sRow
  79. End Sub
  80.  
  81.  
Jul 22 '10 #1

✓ answered by MikeTheBike

@prashantdixit
Hi again

Not to short this asnswers all you problems but I suggest you change the bit of code
Expand|Select|Wrap|Line Numbers
  1. For sRow = 2 To Range("A65536").End(xlUp).Row 
  2.      'use pattern matching to find "File Type" anywhere in cell 
  3.      If SourceSheet.Cells(sRow, "A") = Extention Then 
  4.         'copy cols A,F,E & D 
  5.          'SourceSheet.Cells(sRow, "B").Copy Destination:=DestSheet.Cells(dRow, cDatasetType) 
  6.         DestSheet.Cells(dRow, cDatasetType) = SourceSheet.Cells(sRow, "B") 
  7.         'DestSheet.Cells(i, cNamedReference) = SourceSheet.Cells(sRow, "C") 
  8.      End If 
  9.   Next sRow 
to this
Expand|Select|Wrap|Line Numbers
  1. For sRow = 2 To SourceSheet.Range("A65536").End(xlUp).Row
  2.      'use pattern matching to find "File Type" anywhere in cell
  3.      If Trim(UCase(SourceSheet.Cells(sRow, "A"))) = Trim(UCase(Extention)) Then
  4.         'copy cols A,F,E & D
  5.          'SourceSheet.Cells(sRow, "B").Copy Destination:=DestSheet.Cells(dRow, cDatasetType)
  6.         DestSheet.Cells(dRow, cDatasetType) = SourceSheet.Cells(sRow, "B")
  7.         'DestSheet.Cells(i, cNamedReference) = SourceSheet.Cells(sRow, "C")
  8.      End If
  9.   Next sRow
Using Trim() and UCase() will remove any ambiguity with leading and trailing spaces and make it case insensity.

I have also added the sourcesheet reference when finding the last row in the source sheet (as it was you were finding the last row in the currently active sheet, which is the destination sheet!).

Other than that, ity seem to work OK.

HTH


MTB

Share this Question
Share on Google+
2 Replies


Expert 100+
P: 634
@prashantdixit
Hi again

Not to short this asnswers all you problems but I suggest you change the bit of code
Expand|Select|Wrap|Line Numbers
  1. For sRow = 2 To Range("A65536").End(xlUp).Row 
  2.      'use pattern matching to find "File Type" anywhere in cell 
  3.      If SourceSheet.Cells(sRow, "A") = Extention Then 
  4.         'copy cols A,F,E & D 
  5.          'SourceSheet.Cells(sRow, "B").Copy Destination:=DestSheet.Cells(dRow, cDatasetType) 
  6.         DestSheet.Cells(dRow, cDatasetType) = SourceSheet.Cells(sRow, "B") 
  7.         'DestSheet.Cells(i, cNamedReference) = SourceSheet.Cells(sRow, "C") 
  8.      End If 
  9.   Next sRow 
to this
Expand|Select|Wrap|Line Numbers
  1. For sRow = 2 To SourceSheet.Range("A65536").End(xlUp).Row
  2.      'use pattern matching to find "File Type" anywhere in cell
  3.      If Trim(UCase(SourceSheet.Cells(sRow, "A"))) = Trim(UCase(Extention)) Then
  4.         'copy cols A,F,E & D
  5.          'SourceSheet.Cells(sRow, "B").Copy Destination:=DestSheet.Cells(dRow, cDatasetType)
  6.         DestSheet.Cells(dRow, cDatasetType) = SourceSheet.Cells(sRow, "B")
  7.         'DestSheet.Cells(i, cNamedReference) = SourceSheet.Cells(sRow, "C")
  8.      End If
  9.   Next sRow
Using Trim() and UCase() will remove any ambiguity with leading and trailing spaces and make it case insensity.

I have also added the sourcesheet reference when finding the last row in the source sheet (as it was you were finding the last row in the currently active sheet, which is the destination sheet!).

Other than that, ity seem to work OK.

HTH


MTB
Jul 22 '10 #2

P: 36
Thanks again.
it worked
Jul 23 '10 #3

Post your reply

Sign in to post your reply or Sign up for a free account.