PDA

View Full Version : Importing data from multiple files by VBA



incognito
08-23-2018, 08:38 AM
Hi experts!

I am trying to import and list a range of data from multiple files kept in a Folder.

My aim is:
1. To get the data range imported to a Sheet named "DATA" in a master worksheet.
2. To be able to use the extracted data at "DATA" sheet through formula in other 3 sheets of MASTER file.
3. To get rid of the blank rows from input ranges.
4. To be able to run the code automatically once I open the MASTER worksheet.
5.

I tried the following code:



Sub Test() Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("DATA").Cells.ClearContents
Dim LastRow As Long
Dim firstRow As Long
Dim myDir As String, fn As String, n As Long, t As Long, Cell As String
Const wsName As String = "Summary of the Year"
Const myRng As String = "G77:U796"
myDir = "D:\Aircrew_Flying_Hour"
fn = Dir(myDir & "\*.xlsx")
If fn = "" Then MsgBox "No files in the folder": Exit Sub
With Range(myRng)
n = .Rows.Count: t = .Columns.Count
Cell = .Cells(1).Address(0, 0)
End With
Do While fn <> ""
With Sheets("Data").Range("a" & Rows.Count).End(xlUp)(1).Resize(n, t)

.Formula = "=if('" & myDir & "\[" & fn & "]" & wsName & "'!" & Cell & "<>""""," & _
"'" & myDir & "\[" & fn & "]" & wsName & "'!" & Cell & ","""")"
.Value = .Value
End With
fn = Dir
Loop
firstRow = Sheets("DATA").Range("A1:A" & Sheets("DATA").Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
LastRow = Sheets("DATA").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("DATA").Range("A" & firstRow & ":A" & LastRow).AutoFilter Field:=1, Criteria1:="="
Sheets("DATA").Range("A" & firstRow & ":A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
If Sheets("DATA").AutoFilterMode Then Sheets("DATA").AutoFilterMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Problem is:
1. When I run the code, the code clears all previous data and import fresh data, all cells in Sheet 2,3 and 4 where I have used any type of formula linking to DATA Sheet turns into "#REF!"

2. I tried changing

Sheets("DATA").Range("A" & firstRow & ":A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
to

Sheets("DATA").Range("A" & firstRow & ":A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.ClearContents

Doing this I could get rid of #REF! error but now the blank rows in the range started to appear.

3. I do not know due what error the last row (with value) of my desired range from each source files are not imported. I am getting the total data range minus 1 row of information from each source files.

I tried to get a solution at mrexcel but not getting a response for long. Link below:

https://www.mrexcel.com/forum/excel-questions/1067577-hyperlinking-data-other-sheets-one-sheet-where-data-imported-macro.html

I am using Excel 2010. Can anyone please help!

offthelip
08-24-2018, 01:19 AM
I responded to your query on mrexcel, but didn't follow it up because I didn't understand what you meant by:

To get rid of the blank rows from input ranges.
Can you be more explicit about what you mean by this.

incognito
08-24-2018, 01:29 AM
Thanks for your reply!

I meant that the range I am trying to import from source files is G77:U796 where I have blank rows as well. So while importing to my master file I want to get rid of those. This is already included in the code.

offthelip
08-24-2018, 09:02 AM
I understand what you are trying to do, I think there is a very easy way round it:
Instead of importing the file directly into your master sheet ("DATA"), import them into a temp sheet ( which you can create and then delete at the end) , thne copy the rows which have data into your master sheet.
I would do the copy using variant arrays but you could do using filter and range to range copy.

incognito
08-24-2018, 10:57 AM
I understand what you are trying to do, I think there is a very easy way round it

Actually the array is large and there are too many source files otherwise I would not have tried it with VBA.

I do not understand what you mean by:

Instead of importing the file directly into your master sheet ("DATA"), import them into a temp sheet ( which you can create and then delete at the end) , thne copy the rows which have data into your master sheet.
I would do the copy using variant arrays but you could do using filter and range to range copy.

Even if I create a temp sheet, if I run the code the same problem will appear as master sheet will be dependent on the imported data through hyperlink!

offthelip
08-24-2018, 11:21 AM
I have written some code to do what I suggested in situe using variant arrays so use this code:

farr = Sheets("DATA").Range("A" & firstrow & ":A" & lastrow).Formula
inarr = Sheets("DATA").Range("A" & firstrow & ":A" & lastrow)
Sheets("DATA").Range("A" & firstrow & ":A" & lastrow) = ""
outarr = Sheets("DATA").Range("A" & firstrow & ":A" & lastrow)
indi = 1
For i = firstrow To lastrow
tt = InStr(farr(i, 1), "=")
If tt > 0 Then
' copy the row
outarr(indi, 1) = inarr(i, 1)
indi = indi + 1
End If
Next i



Sheets("DATA").Range("A" & firstrow & ":A" & lastrow) = outarr



instead of these three lines of code:


Sheets("DATA").Range("A" & firstrow & ":A" & lastrow).AutoFilter Field:=1, Criteria1:="="
Sheets("DATA").Range("A" & firstrow & ":A" & lastrow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
If Sheets("DATA").AutoFilterMode Then Sheets("DATA").AutoFilterMode = False

incognito
08-24-2018, 12:36 PM
Yeah. #REF! error is gone!

But now the data are not arranged like before. And the data that were supposed to be in Column A are missing.

I want the destination sheet to look like:

https://www.dropbox.com/s/k3dmm39spsedmjb/Screenshot_2.jpg?dl=0

With your code now it looks like below with a lot of blank rows:

https://www.dropbox.com/s/9ygh0f27yi4ab89/Untitled.jpg?dl=0

offthelip
08-24-2018, 01:02 PM
You are not giving me enough clues to work out what you want, which I suspect is why you didn't get a sufficient response from MrEXcel.
I have written some code for you that will remove blank lines from a worksheet without deleting the rows. I suggest you try and understand what I have written and then modify it yourself to suit what you actually need.

incognito
08-25-2018, 01:44 AM
Thank you! I will try that.