Need to combined 87 xlsx worksheets into 1 & append source filename to each record

[PamK]

I have 87 xlsx worksheets that I need to combined into 1. The caveat is that I need to add the source worksheet name to each record. Each worksheet contains a header and not all cells are populated in the 87 worksheets.

The data is populated in columns A through J on all worksheets, however, some cells are not populated.

I have tried using KB #151 and KB # 221 just to combine, but it did not work. In reviewing the code for the KB code, all files are referred to as xls and not xlsx. I'm not sure if that is why it didn't work. However, I do need the source worksheet name added to the records in column "K", so it is a moot point.

Attached is a sample of the first 200 records from each of the first 3 files combined with the source filename appended in column "K". Sure hope someone can help me out with this.

[Bob Phillips]

Public Sub MergeFiles()
Dim this As Worksheet
Dim lastrow As Long
Dim nextrow As Long
Dim i As Long

Set this = ActiveSheet

With Application.FileDialog(msoFileDialogFilePicker)

.AllowMultiSelect = True
.InitialFileName = "*.xls*"
If .Show = -1 Then

this.Range("A1:K1").Value = Array("FIRSTNAME", "LASTNAME", "ADDRESSLINE1", "ADDRESSLINE2", _
"CITY", "STATE", "ZIPCODE", "AGEOFINDIVIDUAL", _
"ESTINCOME", "ORDER", "Sourcefile")
nextrow = 2
For i = 1 To .SelectedItems.Count

Workbooks(i).Open
lastrow = ActiveWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
ActiveWorkbook.Worksheets(1).Range("A2").Resize(lastrow - 1, 10).Copy this.Cells(nextrow, "A")
this.Cells(nextrow, "K").Resize(lastrow - 1).Value = Activeworkbook.Name
ActiveWorkbook.Close savechanges:=False

nextrow = nextrow + lastrow - 1
Next i
End If
End With
End Sub

[GTO]

Howdy from Arizona Pam,

I see that you joined in August, but that this is only your second post, so a belated welcome to vbaexpress:wavey:


I have 87 xlsx worksheets that I need to combined into 1. The caveat is that I need to add the source worksheet name to each record. Each worksheet contains a header and not all cells are populated in the 87 worksheets.


Okay, what I think we need to know are some "rules" or things we can count on. Are the 87 workbooks all in one folder, or???

Is it only one worksheet per workbook that we need to rip data from?

If so, is it (a) always the first sheet in the workbook, or (b) always a sheet named nnnn?


The data is populated in columns A through J on all worksheets, however, some cells are not populated.


I don't think that should give us any issue, but am curious. In your attached output example, there are numbers stored as text and dates stored as text. (Yuck.) Is that true in the source workbooks?

And just because it caught my eye, why is there no extension showing for 'CHN DEC10 FINAL PENDED LIST'?

Mark

[PamK]

To your first question; yes, all workbooks are in one folder.
Second, yes, only one worksheet per workbook and they are all the first worksheet.
Third, yes, all cells in all worksheets are text.
Fourth, that was my error not included the file extension for the 'CHN DEC10 FINAL PENDED LIST' filename.

Thanks for looking at this!!!!

[GTO]

Thank you Pam :-)

Have you tried XLD's solution?

[PamK]

Yes, I did and it stopped at "Workbooks(i).Open"

[GTO]

Yes, I did and it stopped at "Workbooks(i).Open"

Ahh... Only as Bob (XLD) appears offline, change:

Workbooks(i).Open
To:

Workbooks.Open .SelectedItems(I)

I like Bob's because you can select only the files you want and do not have to fret over whether there might be other workbooks (that we do not want) in the same folder.

If we are certain that all the workbooks in the folder are wanted however, I was thinking of using the FolderPicker, so here is what I came up with:

Option Explicit

Public Sub CombineData()
Dim FSO As Object ' Scripting.FileSystemObject
Dim fsoFol As Object ' Scripting.Folder
Dim fsoFil As Object ' Scripting.File
Dim wks As Worksheet
Dim rngTemp As Range
Dim rngStart As Range

With Application.FileDialog(msoFileDialogFolderPicker)

.InitialFileName = vbNullString
.InitialView = msoFileDialogViewDetails
.Title = "Pick the folder with all the files in it"

If .Show = -1 Then 'If user did not cancel...

'Set a reference to FileSystemObject and then to the Folder we picked.
Set FSO = CreateObject("Scripting.FileSystemObject")
Set fsoFol = FSO.GetFolder(PathFixed(.SelectedItems(1)))

For Each fsoFil In fsoFol.Files

'If (hopefully) the file isn't open and it's a workbook...
If Not Trim$(Left(fsoFil.Name, 2)) = "~$" _
And fsoFil.Type Like "Microsoft Excel *Worksheet" Then

'Open and set a reference to the first worksheet...
Set wks = Workbooks.Open(fsoFil.Path, False, True).Worksheets(1)
Set rngTemp = Nothing
Set rngTemp = RangeFound(wks.Range("A:J"))

If Not rngTemp Is Nothing Then 'Test for blank sheet.
Set rngStart = Nothing
Set rngStart = RangeFound(shtResults.Range("A:J"))
If Not rngStart Is Nothing Then
'Set a reference to the source range (increased by one column)
Set rngTemp = Range(wks.Range("A2"), wks.Range("K" & rngTemp.Row))
'Plunk the filename in to bring across to destination range
rngTemp.Columns(11).Cells.Value = wks.Parent.Name
'Plunk in the values
shtResults.Range("A" & rngStart.Offset(1).Row) _
.Resize(rngTemp.Rows.Count, rngTemp.Columns.Count).Value = rngTemp.Value
Else
GoTo Jump
End If
Else
GoTo Jump
End If
End If

Jump: wks.Parent.Saved = True
wks.Parent.Close False
Next

shtResults.UsedRange.Columns.EntireColumn.AutoFit

End If
End With
End Sub

Public Function PathFixed(ByVal Path As String, _
Optional IncludeTrailingSeperator As Boolean = True _
) As String

Do While Right$(Path, 1) = "\"
Path = Left$(Path, Len(Path) - 1)
Loop

If IncludeTrailingSeperator Then Path = Path & "\"

PathFixed = Path

End Function

Function RangeFound(SearchRange As Range, _
Optional ByVal FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function
Hope that helps,

Mark

[snb]

If your files reside in G:\OF\


sub M_snb()
sn=split(createobject("wscript.shell").exec("cmd /c Dir ""G:\OF\*.xlsx"" /b").stdout.readall,vbcrlf)

for j=0 to ubound(sn)
with getobject(sn(j)).sheets(1).usedrange
Thisworkbook.sheets(1).cells(rows.count,1).end(xlup).offset(1).resize(.rows .count,.columns.count)=.value
.parent.parent.close 0
end with
next
End Sub

[PamK]

Thanks so much! It's still producing an error at----- Set rngStart = RangeFound(shtResults.Range("A:J")) Error states variable not defined.

[GTO]

Sorry Pam, I should have explained that bit. See, worksheets and some other things have what is referred to as a CodeName Property. In VBE, look in the project's Project window (usually upper left) and double-click the worksheet you want to be the destination. Now down in the Properties window (for the worksheet's module) you will see two 'Name' properties. The upper one with parenthesis around it is the sheet's CodeName (check out CodeName in VBA Help).

Change this to: shtResults

Now even if someone changes the name on the sheet's tab, the code still works, as it refers to the codename/object name.

Mark

[PamK]

Thanks Mark! Sorry for the delayed response. Will give it a try. Thank you so very much for all your assistance!!!!! :)

[Bob Phillips]

Yes, I did and it stopped at "Workbooks(i).Open"

Sorry Pam, lack of testing.


Workbooks(i).Open

should be


Workbooks.Open Filename:= .SelectedItems(i)

[mancubus]

to append the file names to
If your files reside in G:\OF\
sub M_snb()End Sub just add
ThisWorkbook.Sheets(1).Cells(Rows.Count, .Columns.Count + 1).End(xlUp).Offset(1).Resize(.Rows.Count) = sn(j) before .parent.parent.close 0 line

[PamK]

Thank you all so very much; works like a charm!!!!!!!