1

I'm new to VBA so not exactly sure how this all works but I've got the jist. I am trying to import data from multiple workbooks into one workbook that is created by the program. I have got the main importing done correctly (although not effeciently) but then one of three things happens: The data is imported into correct places and is fine, the data overlaps after the first set, or only the first set of data is transferred. I just can't work out why!

  Do 
     Filename = InputBox("What is the full path and name of the file?")      
     Workbooks.Open (Filename)
     data_range = InputBox("What is the cell range of the wanted data in the original file? If this is the first set of data, include the titles for reference")
     ActiveSheet.Range(data_range).Select
     Selection.Copy
     ActiveWorkbook.Close
    If first = True Then
      ActiveSheet.Range("b2").Select
    End If
    If first = False Then
      ActiveSheet.Range("b" & (difference + 3)).Select
    End If

    ActiveSheet.Paste
    ActiveSheet.Range("a1").Select
    again = MsgBox("Would you like to import another set of data?", 4)
    Call start_cell(range_of_cells, data_range)
    first = False

  Loop Until again = vbNo

That was the main program. The sub-procedure start_cell is below:

    range_of_cells = Split(data_range, ":")
    NUMBERS(0) = Right(range_of_cells(0), 2)
    NUMBERS(1) = Right(range_of_cells(1), 2)

    check = IsNumeric(NUMBERS(0))
    If check = False Then
        'wrong
    End If
    check = IsNumeric(NUMBERS(1))
    If check = False Then
        'wrong
    End If

    difference = (NUMBERS(1) - NUMBERS(0)) + difference

Any help would be awesome. Also if there are any more effecient ways that'd be great.

Samiko
  • 191
  • 1
  • 3
  • 11
  • Are the files you are using stored in one folder? And does the data start at the same place? E.g. all your files are saved under C:\Sammy\Excel-files\ and the data always starts in Sheet1 Range A1. – xificurC Jul 10 '14 at 12:58
  • @xificurC The data in original files always starts at A17 but in each of the different books there is a different amount of data. All of the files are in the same folder yes. – Samiko Jul 10 '14 at 13:29
  • @xificurC sorry just re-read your comment, the range A1 is for just to deselect everything else as A1 is covered by a button anyway. Sorry for that. The first set of data is meant to start at B2 - which works - and the rest relative to it, which is where my problem is. – Samiko Jul 10 '14 at 13:41

1 Answers1

2

This is a sketch of what could work, check it, run it, customize it and let me know if something isn't working or I misunderstood your question.

Function GetFolder(ByVal sTitle As String) As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = sTitle
        .Show
        On Error Resume Next
        GetFolder = .SelectedItems(1)
        On Error GoTo 0
    End With
End Function

Sub Main()

    Const START_ADDR As String = "A17"
    Dim sPath As String, sFile As String
    Dim wbLoop As Workbook
    Dim wsLoop As Worksheet, wsConsolidate As Worksheet
    Dim rData As Range

    'save current sheet in variable (change if required)
    wsConsolidate = ActiveSheet

    'ask for folder
    sPath = GetFolder("Select the folder where your files reside.")
    'if none provided quit
    If sPath = "" Then
        MsgBox "No folder selected."
        Exit Sub
    End If

    'get all excel files from specified folder
    sFile = Dir(sPath & "\*.xls*")
    Do Until sFile = ""
        'open file
        Set wbLoop = Workbooks.Open(sPath & "\" & sFile)
        Set wsLoop = wbLoop.Sheets(1) 'change if other
        'copy data out
        Set rData = wsLoop.Range(START_ADDR).CurrentRegion
        'if the data has headers uncomment below
        'Set rData = rData.Offset(1, 0).Resize(rData.Rows.Count)
        rData.Copy wsConsolidate.Cells(wsConsolidate.Rows.Count, "B").End(xlUp).Offset(1, 0)
        'close file without saving
        wbLoop.Close False
        'loop through files
        sFile = Dir
    Loop

End Sub
xificurC
  • 1,168
  • 1
  • 9
  • 17
  • Thank you, that works almost perfectly, the only problem is that the headings from each table copy over as well (this is a problem as I need contiguous data to make a histogram) - instead of just the first but I should be able to sort that. Otherwise it is great. Many thanks: Sammy – Samiko Jul 10 '14 at 14:29
  • @SammyEko - uncomment the other `Set rData = ...` line and you should get rid of the headings – xificurC Jul 10 '14 at 14:33
  • Sorry missed that whilst adding the histogram code to it, thanks again. error 424 "object required" comes up after uncommenting? Not sure what this means – Samiko Jul 10 '14 at 14:34
  • Error 424: "Object Required" now happens when I run after uncommenting, then after re-commenting it works again. Not sure how to sort this (sorry, amateur in case you hadnt guessed) – Samiko Jul 10 '14 at 14:45
  • @SammyEko - there was a typo in that line, had `rdta` instead of `rData`. Try copying the line now or just correct it in your code and it should (hopefully) work. – xificurC Jul 10 '14 at 14:48
  • Thank you, that is perfect now, I've made minor additions and changed. I would +1 but not got enough rep yet. So sorry. – Samiko Jul 10 '14 at 14:52