Excel Populate workbook A from Data in workbook B based off criteria in Workbook C

Joined
Feb 23, 2017
Messages
1
Reaction score
0
My question is a little complex. I already have a VBA macro set up to open two files and I have it to a point where I can get the two to "talk" to each other. What I need is for the macro to be able to go into the UPC workbook (I am posting images of my files so it makes sense) find the cell data that is associated with the item number and under a specific header. Then go into the Quicksheet workbook and find the same item number and based off of the header options saved in the Vendor work book find the associated header and paste the associated information as text. I am including the code I am using below

Module 1
Sub select_UPC_folder()
Dim objShell As Object, ssfWINDOWS As Long, objFolder As Object

ssfWINDOWS = 36

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Folder Selection:", 0, ssfWINDOWS)
If objFolder Is Nothing Then Exit Sub

SaveSetting "JELDWEN", "Paths", "UPC Path", objFolder.Self.Path

ThisWorkbook.Worksheets("VP_Macro").Shapes("UPC Folder"). _
TextFrame.Characters.Text = objFolder.Self.Path


End Sub


Sub select_Vendor_folder()
Dim objShell As Object, ssfWINDOWS As Long, objFolder As Object

ssfWINDOWS = 36

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Folder Selection:", 0, ssfWINDOWS)
If objFolder Is Nothing Then Exit Sub

SaveSetting "JELDWEN", "Paths", "Vendor Path", objFolder.Self.Path

ThisWorkbook.Worksheets("VP_Macro").Shapes("Vendor Folder"). _
TextFrame.Characters.Text = objFolder.Self.Path


End Sub


Module 2
Sub process_names()
Dim fldr_pth_UPC As String, wb_data As Workbook, ws_data As Worksheet, ws_Headers As Worksheet
Dim info As Variant, data_set As Variant, ws_Vendor As Worksheet, ws_UPC As Worksheet
Dim wf As WorksheetFunction, wb_Macro As Workbook
Dim fldr_pth_Vendor As String, fldr_Vendor As Object, Vendor_pth As String
Dim wb_Vendor As Workbook, info_item As Variant, col_stat As Long, prod_stat As String

'///////////////////////////////////////////////////////////////////////
'//////Change Product Column Going After in Main Data File//////////////
col_prod = 7
col_stat = 3
'//////////////////////////////////////////////////////////////////////

'Put at top of code
Application.ScreenUpdating = False 'Turn off screen updating for speed
Application.DisplayAlerts = False 'Turn off message system of Excel, picks defaults

'These are fixed, so put at top
Set ws_Headers = ThisWorkbook.Worksheets("Headers")
Set wf = WorksheetFunction

Dim fs As Object, fldr_UPC As Object
Dim file As Object, prod_pth As String

fldr_pth_UPC = GetSetting("JELDWEN", "Paths", "UPC Path", "N/A")
fldr_pth_Vendor = GetSetting("JELDWEN", "Paths", "Vendor Path", "N/A")

If fldr_pth_UPC = "N/A" Then
MsgBox "Please set the folder path to the UPC workbook.", 16, "Folder Not Set"
Exit Sub
End If

If fldr_pth_Vendor = "N/A" Then
MsgBox "Please set the folder path to the Vendor workbook.", 16, "Folder Not Set"
Exit Sub
End If


Set fs = CreateObject("Scripting.FileSystemObject")
Set fldr_Vendor = fs.GetFolder(fldr_pth_Vendor)
Set fldr_UPC = fs.GetFolder(fldr_pth_UPC)

For Each file In fldr_UPC.Files
If InStr(1, file.Name, "UPC", vbTextCompare) > 0 Then
UPC_pth = file.Path
Exit For
End If
Next file

If UPC_pth = "" Then
MsgBox "UPC workbook could not be located.", 16, "Workbook Not Found"
Exit Sub
End If

For Each file In fldr_Vendor.Files
If InStr(1, file.Name, "Quicksheet", vbTextCompare) > 0 Then
Vendor_pth = file.Path
Exit For
End If
Next file

If Vendor_pth = "" Then
MsgBox "Vendor workbook could not be located.", 16, "Workbook Not Found"
Exit Sub
End If

'Use ReadOnly argument to allow multiple users to open at once
'Open is an accessor, it locks on to workbook just opened, so use it in Set statement to track workbook
Set wb_UPC = Workbooks.Open(Filename:=UPC_pth, ReadOnly:=True) '~Workbooks.Item()
Set wb_Vendor = Workbooks.Open(Filename:=Vendor_pth, ReadOnly:=True) '~Workbooks.Item()
Set ws_UPC = wb_UPC.ActiveSheet 'Since only one sheet in wb then track with ActiveSheet
Set ws_Vendor = wb_Vendor.ActiveSheet

If ws_UPC.Range("A1") = 1 Then
ws_Vendor.Range("A1") = 1
End If



End Sub
 

Attachments

  • Quicksheet.webp
    Quicksheet.webp
    61.5 KB · Views: 114
  • UPC.webp
    UPC.webp
    64 KB · Views: 132
  • Vendor Export (Data).webp
    Vendor Export (Data).webp
    59 KB · Views: 156
  • Vendor Export (Headers).webp
    Vendor Export (Headers).webp
    60.7 KB · Views: 161
  • Vendor Export (VP_Macro).webp
    Vendor Export (VP_Macro).webp
    45.3 KB · Views: 137
Back
Top