Copying and pasting onto mastersheet but files have different formats (need if statement help)

F

faithtirta

New Member
Joined
May 1, 2023
Messages
7
Office Version
  1. 365
Platform
  1. Windows
Hi all,

I am needing assistance with my code. I need the macro to go through files in a folder that contain vendor contact forms. I need to copy certain cells from each file (there are hundreds of files) and paste them into a master sheet. The fomats of the vendor contact files are different in which format 1 has First name and Last name combined into one column (B12:B16) while format 2 has first name and last name separated into two columns but in the master sheet I want the first name and last name to be in two seperate files,

Not only that but format 1 has contact information starting on A12:E12 and ending on A16:E16. However, in format 2 contact information begins on A13:F13 and ends A19:F19. Column A corresponds to Position in the Master sheet. Vendor inormation is consistent throughout the files. The end goal for the macro is to go through each file and pull the vebdor information adn the contacts for each vendor into a mastersheet (as shown in the screenshot). For each contact I need the basic vendor information to correspond to the vendor that the contact is for. I am wanting to use this macro so that whenever I have a new vendor contact form I can place it in the folder and run the macro so that it adds to the next available row on the Mastersheet.

1683750517258.png

Cell References that are consistent for both formats:
Vendor Name: B4:C4
Address 1: B5:C5
Address 2: B6:C6
City, State, Zip: B7:C7
Main Office Phone B8:C8

Attached is the code that I am using in which this code is very slow and only copies the very last contact information on the form and disregards the contacts before it. This code also only works with the format 2 not format 1. Please help - I have tried avoiding copying cells and just make the target range value equal the source range value but that code was not successful in pulling any information. I believe an if statement is required for the different formatting but I can't figure out how to go about it.

VBA Code: 
Private Sub VendorContactMacro()

   Dim strPath As String
   Dim strFile As String
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim wsTarget As Worksheet
   Dim LastRow As Long
  
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  
   strPath = "\\usdls7erfs02\group$\Merchandising\Merchandising\Merchandising Supplier Support\New Vendors\!!New Vendors\Completed Vendors\JENNIFER FILE FOR VENDOR CONTACTS\VENDOR CONTACT FORMS"
   If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
 
   'set the target worksheet
   Set wsTarget = ActiveWorkbook.Worksheets("Master Sheet 2")
 
  
   'get the first file
   strFile = Dir(strPath & "*.xlsx*")
  
   'loop throught the excel files in the folder
   Do While strFile <> ""

         'open the workbook
         Set wbSource = Workbooks.Open(strPath & strFile)
         Set wsSource = wbSource.Worksheets(1)
         
         'set last row
         LastRow = wsTarget.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
         
         'copy and paste
            wsSource.Range("B4:C4").Copy
            wsTarget.Cells(LastRow, 1).PasteSpecial xlPasteValues
            wsSource.Range("B5:C5").Copy
            wsTarget.Cells(LastRow, 2).PasteSpecial xlPasteValues
            wsSource.Range("B6:C6").Copy
            wsTarget.Cells(LastRow, 3).PasteSpecial xlPasteValues
            wsSource.Range("B7:C7").Copy
            wsTarget.Cells(LastRow, 4).PasteSpecial xlPasteValues
            wsSource.Range("B8:C8").Copy
            wsTarget.Cells(LastRow, 5).PasteSpecial xlPasteValues
            wsSource.Range("A13").Copy
            wsTarget.Cells(LastRow, 6).PasteSpecial xlPasteValues
            wsSource.Range("B13").Copy
            wsTarget.Cells(LastRow, 7).PasteSpecial xlPasteValues
            wsSource.Range("C13").Copy
            wsTarget.Cells(LastRow, 8).PasteSpecial xlPasteValues
            wsSource.Range("D13").Copy
            wsTarget.Cells(LastRow, 9).PasteSpecial xlPasteValues
            wsSource.Range("E13").Copy
            wsTarget.Cells(LastRow, 10).PasteSpecial xlPasteValues
            wsSource.Range("F13").Copy
            wsTarget.Cells(LastRow, 11).PasteSpecial xlPasteValues
            wsSource.Range("A14").Copy
            wsTarget.Cells(LastRow, 6).PasteSpecial xlPasteValues
            wsSource.Range("B14").Copy
            wsTarget.Cells(LastRow, 7).PasteSpecial xlPasteValues
            wsSource.Range("C14").Copy
            wsTarget.Cells(LastRow, 8).PasteSpecial xlPasteValues
            wsSource.Range("D14").Copy
            wsTarget.Cells(LastRow, 9).PasteSpecial xlPasteValues
            wsSource.Range("E14").Copy
            wsTarget.Cells(LastRow, 10).PasteSpecial xlPasteValues
            wsSource.Range("F14").Copy
            wsTarget.Cells(LastRow, 11).PasteSpecial xlPasteValues
            wsSource.Range("A15").Copy
            wsTarget.Cells(LastRow, 6).PasteSpecial xlPasteValues
            wsSource.Range("B15").Copy
            wsTarget.Cells(LastRow, 7).PasteSpecial xlPasteValues
            wsSource.Range("C15").Copy
            wsTarget.Cells(LastRow, 8).PasteSpecial xlPasteValues
            wsSource.Range("D15").Copy
            wsTarget.Cells(LastRow, 9).PasteSpecial xlPasteValues
            wsSource.Range("E15").Copy
            wsTarget.Cells(LastRow, 10).PasteSpecial xlPasteValues
            wsSource.Range("F15").Copy
            wsTarget.Cells(LastRow, 11).PasteSpecial xlPasteValues
            wsSource.Range("A16").Copy
            wsTarget.Cells(LastRow, 6).PasteSpecial xlPasteValues
            wsSource.Range("B16").Copy
            wsTarget.Cells(LastRow, 7).PasteSpecial xlPasteValues
            wsSource.Range("C16").Copy
            wsTarget.Cells(LastRow, 8).PasteSpecial xlPasteValues
            wsSource.Range("D16").Copy
            wsTarget.Cells(LastRow, 9).PasteSpecial xlPasteValues
            wsSource.Range("E16").Copy
            wsTarget.Cells(LastRow, 10).PasteSpecial xlPasteValues
            wsSource.Range("F16").Copy
            wsTarget.Cells(LastRow, 11).PasteSpecial xlPasteValues
            wsSource.Range("A17").Copy
            wsTarget.Cells(LastRow, 6).PasteSpecial xlPasteValues
            wsSource.Range("B17").Copy
            wsTarget.Cells(LastRow, 7).PasteSpecial xlPasteValues
            wsSource.Range("C17").Copy
            wsTarget.Cells(LastRow, 8).PasteSpecial xlPasteValues
            wsSource.Range("D17").Copy
            wsTarget.Cells(LastRow, 9).PasteSpecial xlPasteValues
            wsSource.Range("E17").Copy
            wsTarget.Cells(LastRow, 10).PasteSpecial xlPasteValues
            wsSource.Range("F17").Copy
            wsTarget.Cells(LastRow, 11).PasteSpecial xlPasteValues
            wsSource.Range("A18").Copy
            wsTarget.Cells(LastRow, 6).PasteSpecial xlPasteValues
            wsSource.Range("B18").Copy
            wsTarget.Cells(LastRow, 7).PasteSpecial xlPasteValues
            wsSource.Range("C18").Copy
            wsTarget.Cells(LastRow, 8).PasteSpecial xlPasteValues
            wsSource.Range("D18").Copy
            wsTarget.Cells(LastRow, 9).PasteSpecial xlPasteValues
            wsSource.Range("E18").Copy
            wsTarget.Cells(LastRow, 10).PasteSpecial xlPasteValues
            wsSource.Range("F18").Copy
            wsTarget.Cells(LastRow, 11).PasteSpecial xlPasteValues
            wsSource.Range("A19").Copy
            wsTarget.Cells(LastRow, 6).PasteSpecial xlPasteValues
            wsSource.Range("B19").Copy
            wsTarget.Cells(LastRow, 7).PasteSpecial xlPasteValues
            wsSource.Range("C19").Copy
            wsTarget.Cells(LastRow, 8).PasteSpecial xlPasteValues
            wsSource.Range("D19").Copy
            wsTarget.Cells(LastRow, 9).PasteSpecial xlPasteValues
            wsSource.Range("E19").Copy
            wsTarget.Cells(LastRow, 10).PasteSpecial xlPasteValues
            wsSource.Range("F19").Copy
            wsTarget.Cells(LastRow, 11).PasteSpecial xlPasteValues
         
         wbSource.Close SaveChanges:=False

      'get the next file
      strFile = Dir()
   Loop
  
   MsgBox ("Done")
  
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

I have attached both vendor contat formats - I cant figure out how to use xl2bb its not letting me copy anything - mini sheet and table only is grayed out (see screenshot below). I also do not have a dropbox account so I cant attach any actual files - if anyone needs the files and wants to help please reach out.
1683757907491.png

Vendor contact form format 1:
1683757944599.png

Vendor contact form format 2:
1683758028721.png

Master Sheet Format:
1683758100502.png
 
Sort by date Sort by votes
You can put this in for Case 2 if you could have single names. It will always place the name in the First Name column, but we can force it to the Last Name column if you would like. However, you only get 1 or the other.
VBA Code: 
                   Case 2
                        If myData(k + 1, m) = "" Then
                            v = Array("", "")
                        Else
                            v = Split(myData(k + 1, m))
                        End If
                        If UBound(v) = 0 Then ReDim Preserve v(1)
                        outArray(k, m) = v(1)
 
Upvote 0

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
NateSC said:
Change Case 1 and 2 to this:
VBA Code: 
                    Case 1
                        If myData(k + 1, m + 1) = "" Then
                            v = Array("", "")
                        Else
                            v = Split(myData(k + 1, m + 1))
                        End If
                        outArray(k, m) = v(0)
                    Case 2
                        If myData(k + 1, m) = "" Then
                            v = Array("", "")
                        Else
                            v = Split(myData(k + 1, m))
                        End If
                        outArray(k, m) = v(1)
Click to expand...
This worked perfectly! Thank you so much!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
VBA Copy/Paste New Data Only
Replies
0
Views
434
ah2024_2024
A
F
  • Question Question
Macro that copies and pastes from each file into formatted master sheet with merged cells
Replies
1
Views
941
OaklandJim
O
T
  • Question Question
Copy row values from one worksheet in one workbook to multiple workbooks based on file name
Replies
0
Views
309
thechad
T
D
  • Solved
VBA to paste table into Outlook
Replies
5
Views
730
Dani_LobP
D
Y
  • Question Question
sum total in specific column when it complete 1 quantity in column H
Replies
0
Views
413
yoon
Y

Forum statistics

Threads
1,223,879
Messages
6,175,150
Members
452,615
Latest member
bogeys2birdies

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top