+ Reply to Thread
Results 1 to 2 of 2

VBA to extract data from multiple workbooks into another- problem with blank cells

  1. #1
    Registered User
    Join Date
    04-20-2012
    Location
    Portland Maine
    MS-Off Ver
    Excel 2007
    Posts
    1

    VBA to extract data from multiple workbooks into another- problem with blank cells

    Hi all, I hope someone can help. I have the following code that extracts data from mutliple workbooks and places it in a "summary" workbook. The code works- except if any of the source fields are empty the offset statement does not function as required and the data that should be on the next line appears in the line above. ( if the previous sheet had blank fields)

    My thoughts are that if the field is blank then insert a mesage or "-". The most important thing is to keep the datpoints from the same source workbook on the same line. Thanks in advance!!

    Sub Extract()
    Dim myFile As String, myCurrFile As String
    myCurrFile = ThisWorkbook.Name
    ' Folder location with school data to be extracted (do in 2 batches 1st 20 then 20+)
    myFile = Dir("C:\Draft 2 Summary Matrix\*.xlsx")
    Do Until myFile = ""
    Workbooks.Open "C:\Draft 2 Summary Matrix\" & myFile
    ' School Name
    Workbooks(myCurrFile).Worksheets("Sheet2").Range("A1").End(xlDown).Offset(1, 0) = Workbooks(myFile).Worksheets("Area Input").Range("C2")
    ' Grades
    Workbooks(myCurrFile).Worksheets("Sheet2").Range("B1").End(xlDown).Offset(1, 0) = Workbooks(myFile).Worksheets("Area Input").Range("L2")
    ' Reported Enrollment
    Workbooks(myCurrFile).Worksheets("Sheet2").Range("C1").End(xlDown).Offset(1, 0) = Workbooks(myFile).Worksheets("Area Input").Range("B22")
    ' Dorm 1-8 student count (for schools after first 20- change E13 to E11 for earlier batch)
    Workbooks(myCurrFile).Worksheets("Sheet2").Range("D1").End(xlDown).Offset(1, 0) = Workbooks(myFile).Worksheets("Area Input").Range("E11")
    ' Dorm 9-12 student count (for schools after first 20- change E16 to E14 for earlier batch)
    Workbooks(myCurrFile).Worksheets("Sheet2").Range("E1").End(xlDown).Offset(1, 0) = Workbooks(myFile).Worksheets("Area Input").Range("E14")
    ' Therapy room SF
    Workbooks(myCurrFile).Worksheets("Sheet2").Range("G1").End(xlDown).Offset(1, 0) = Workbooks(myFile).Worksheets("Space Summary detailed").Range("D88")
    ' Resource room K-5 SF
    Workbooks(myCurrFile).Worksheets("Sheet2").Range("H1").End(xlDown).Offset(1, 0) = Workbooks(myFile).Worksheets("Space Summary detailed").Range("D91")
    ' Resource room 6-8 SF
    Workbooks(myCurrFile).Worksheets("Sheet2").Range("I1").End(xlDown).Offset(1, 0) = Workbooks(myFile).Worksheets("Space Summary detailed").Range("D92")
    ' Resource room 9-12 SF
    Workbooks(myCurrFile).Worksheets("Sheet2").Range("J1").End(xlDown).Offset(1, 0) = Workbooks(myFile).Worksheets("Space Summary detailed").Range("D93")
    ' Testing room SF
    Workbooks(myCurrFile).Worksheets("Sheet2").Range("L1").End(xlDown).Offset(1, 0) = Workbooks(myFile).Worksheets("Space Summary detailed").Range("D94")
    ' Gifted and Tallented room SF
    Workbooks(myCurrFile).Worksheets("Sheet2").Range("M1").End(xlDown).Offset(1, 0) = Workbooks(myFile).Worksheets("Space Summary detailed").Range("D95")
    ' Academic Buildings
    Workbooks(myCurrFile).Worksheets("Sheet2").Range("N1").End(xlDown).Offset(1, 0) = Workbooks(myFile).Worksheets("Area Input").Range("B37")
    ' non-Academic Buildings
    Workbooks(myCurrFile).Worksheets("Sheet2").Range("O1").End(xlDown).Offset(1, 0) = Workbooks(myFile).Worksheets("Area Input").Range("B39")
    ' unusable Buildings
    Workbooks(myCurrFile).Worksheets("Sheet2").Range("Q1").End(xlDown).Offset(1, 0) = Workbooks(myFile).Worksheets("Area Input").Range("B41")
    ' portable structures
    Workbooks(myCurrFile).Worksheets("Sheet2").Range("R1").End(xlDown).Offset(1, 0) = Workbooks(myFile).Worksheets("Area Input").Range("B43")
    ' ineligible area
    Workbooks(myCurrFile).Worksheets("Sheet2").Range("S1").End(xlDown).Offset(1, 0) = Workbooks(myFile).Worksheets("Area Input").Range("B27")
    ' surplus or shortfall (for schools with dorms use different field?)
    Workbooks(myCurrFile).Worksheets("Sheet2").Range("T1").End(xlDown).Offset(1, 0) = Workbooks(myFile).Worksheets("Space Summary detailed").Range("E19")

    ' close file and continue loop
    Workbooks(myFile).Close savechanges:=False
    myFile = Dir
    Loop

    End Sub

  2. #2
    Valued Forum Contributor
    Join Date
    06-16-2006
    Location
    Sydney, Australia
    MS-Off Ver
    2013 64bit
    Posts
    1,394

    Re: VBA to extract data from multiple workbooks into another- problem with blank cells

    OK, give this a try. Please be very careful. I haven't been able to test this because I don't have your spreadsheets. Please make sure you take a back up copy first so you can recover if something goes wrong. Let me know if it works.

    Please Login or Register  to view this content.
    Last edited by Mallycat; 04-20-2012 at 11:24 PM.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1