WISDOMBYDATA
  • BLOG
    • Blog Guide
    • Blog History
  • EXCEL
    • Functions & Formulas
    • VBA & Macros
    • VLOOKUP
    • Pivot Tables
    • Conditional Formatting
    • Tricks & Shortcuts
  • BI
    • SAP BOBJ/BW
    • Tableau
  • SQL
  • ABOUT
    • About WBD
    • About Me

Transfer data (Including Null values) from multiple excel sheets into a single repository (Efficient method)

1/22/2019

0 Comments

 

Back in July 2018, I demonstrated how to transfer data form multiple spreadsheets into a single repository. While the method I proposed was very effective, it wasn’t very efficient in the sense that it required many lines of code and used to many statements such as “Select”, “Copy”, “paste”, “Offset” which as discussed in previous blogposts tend to slow down the spreadsheets and negatively impact the speed for executing the macro especially when wanting to transfer large volumes of data.

With this is mind and after noticing that a similar macro I had built runs very slowly on windows 10, I came up with an alternative solution which operates perfect for Win 10 operating systems.

We have multiple user forms (Named Form A, Form B, Form C and Form D) and each form consists of two tabs (i.e "Registration Form" and "Order History".
Picture

​​We want to transfer values from four of the cells in one tab and one cell in the second tab into another spreadsheet named “Customer Inventory Report”
Picture

​The code below takes the 5 values from each input spreadsheet and places them in one row of the output spreadsheet. Pay attention to the parts of the code that are in bold. These are the items that would need to be modified in your code.

Option Explicit
 
Const FOLDER_PATH = "C:\CIS\Forms\"  'REMEMBER END BACKSLASH
 
Sub ImportWorksheets()
 
   Dim sFile As String          
   Dim wsTarget As Worksheet
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim wsSource2 As Worksheet
   Dim wsSource3 As Worksheet
 
   Dim rowTarget As Long         'output row
     
      Application.DisplayStatusBar = False
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
      
   rowTarget = 5          'The first row to which files will be transferred
  
   'check the folder exists
   If Not FileFolderExists(FOLDER_PATH) Then
      MsgBox "Folder does not exist, enter a valid folder path!"
      Exit Sub
   End If
  
   'reset application settings in event of error
   On Error GoTo errHandler
   Application.ScreenUpdating = False
  
   'set up the target worksheet
   Set wsTarget = Sheets("Customers")
  
   'loop through the Excel files in the folder
   sFile = Dir(FOLDER_PATH & "*.xls*")
   Do Until sFile = ""
     
      'open the source file and set the source worksheet
      Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
      Set wsSource = wbSource.Worksheets(1) 'Reference to the "Registration Form" Tab
      Set wsSource2 = wbSource.Worksheets(2) 'Reference to the "Order History" tab
               
      Application.DisplayStatusBar = False
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
      'import the data
      With wsTarget
  
 .Range("A" & rowTarget).Value = wsSource.Range("D7").Value
 .Range("B" & rowTarget).Value = wsSource.Range("D8").Value                                     
 .Range("C" & rowTarget).Value = wsSource.Range("I7").Value
 .Range("D" & rowTarget).Value = wsSource.Range("I8").Value
.Range("E" & rowTarget).Value = wsSource2.Range("A2").Value                                                                                                                                 
      Application.DisplayStatusBar = False
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
         'optional source filename in the last column
         '.Range("N" & rowTarget).Value = sFile
     End With
     
      'close the source workbook, increment the output row and get the next file
      wbSource.Close SaveChanges:=False
      rowTarget = rowTarget + 1
      sFile = Dir()
   Loop
       Application.DisplayStatusBar = False
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
errHandler:
   On Error Resume Next
   Application.ScreenUpdating = True
  
   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing
   'End With
End Sub
    
Private Function FileFolderExists(strPath As String) As Boolean
    If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function


              ****Important notes***

Make sure to make the following adjustments In the code above:

Note#1] The directory for the file in which the spreadsheets are stored must be entered in line 3 of the code with a backlash entered at the end.
Picture
​
​
Note#2] in the following line of code enter the row number for the first row in the target sheet in which data will be transferred. In the case of this example it is row 5.
Picture
​
​
Note#3] Indicate the name of the tab on the target sheet in which data is to be transferred
Picture
​
​
Note#4] Indicate which source sheets need to be selected. For example, wsSource is the first tab and wsSource2 is the second tab as indicated within parenthesis ()
Picture
​Note#5] Map the source cells to the destination column as so.
Picture
​And here is the outcome of the macro. It runs in with remarkable speed and is perfect for large data sets and the Win10 operating system.
Picture
0 Comments



Leave a Reply.

    Categories

    All
    BI
    EXCEL
    MISC
    SQL

    Archives

    June 2020
    May 2020
    April 2020
    March 2020
    February 2020
    December 2019
    November 2019
    October 2019
    September 2019
    August 2019
    July 2019
    June 2019
    May 2019
    April 2019
    March 2019
    February 2019
    January 2019
    December 2018
    November 2018
    October 2018
    September 2018
    August 2018
    July 2018
    June 2018
    May 2018
    April 2018
    March 2018
    September 2017
    August 2017
    July 2017
    June 2017
    May 2017
    April 2017
    March 2017
    February 2017
    January 2017
    December 2016
    November 2016
    October 2016
    September 2016
    August 2016
    July 2016
    June 2016
    May 2016
    April 2016
    March 2016
    February 2016
    May 2015
    April 2015
    March 2015
    February 2015
    January 2015
    December 2014
    November 2014
    October 2014
    September 2014
    August 2014
    April 2014
    March 2014
    February 2014
    January 2014
    December 2013
    November 2013

Powered by Create your own unique website with customizable templates.
  • BLOG
    • Blog Guide
    • Blog History
  • EXCEL
    • Functions & Formulas
    • VBA & Macros
    • VLOOKUP
    • Pivot Tables
    • Conditional Formatting
    • Tricks & Shortcuts
  • BI
    • SAP BOBJ/BW
    • Tableau
  • SQL
  • ABOUT
    • About WBD
    • About Me