Ted Penner
asked on
Insert filename column as column a
I had this question after viewing Fix insertion and shifting issue.
I now need to insert a column called Filename if it does not exist and allow for the filename of the source to be noted in that column.
Assistance is greatly appreciated.
I now need to insert a column called Filename if it does not exist and allow for the filename of the source to be noted in that column.
Assistance is greatly appreciated.
I'll finish this this evening for you
See if this is correct
Option Explicit
Sub simpleXlsMerger()
Dim wsTable As Worksheet, ws As Worksheet
Dim rRng As Range
Dim bookList As Workbook
Dim path As String, MyName As String
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Dim rToCopy As Range, rNextCl As Range
Dim bHeaders As Boolean
Dim lRow As Long
Set ws = ActiveSheet
Set mergeObj = CreateObject("Scripting.FileSystemObject")
With ws.Range("A1")
If Not .Value = "Filename" Then
.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
.Offset(, -1).Value = "Filename"
.Copy
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
End With
'change folder path of excel files here
path = UseFolderDialogOpen
If path = "" Then Exit Sub
Set dirObj = mergeObj.Getfolder(path)
Set filesObj = dirObj.Files
On Error GoTo exit_Proc
' Application.Selection = False
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
'Grab filename from each open file
MyName = everyObj.Name
With ws
Set rRng = .Range("A2").CurrentRegion
If rRng.Cells.Count = 0 Then
'no data in master sheet
bHeaders = False
Else: bHeaders = True
End If
If Not bHeaders Then
Set rNextCl = .Cells(2, 2)
bHeaders = True
Else:
'headers exist so don't copy
Set rNextCl = .Cells(.Rows.Count, 2).End(xlUp).Offset(1)
End If
End With
With ActiveSheet
If bHeaders Then
Set rToCopy = .Range("A1").CurrentRegion.Offset(1)
Else: Set rToCopy = .Range("A1").CurrentRegion
End If
rToCopy.Copy rNextCl.Offset
lRow = ws.Cells(1, 1).CurrentRegion.Rows.Count
'Paste site name to column A
ws.Range("A" & rNextCl.Row & ":" & "A" & lRow).Value = Left(MyName, Len(MyName) - 5)
End With
bookList.Close False
ws.Columns.AutoFit
Next
exit_Proc:
Application.ScreenUpdating = True
' With wsTable
' 'make all cells same height
' .Rows.RowHeight = 15
'
' 'convert sheet2 into table
' Set rRng = .Range("A1").CurrentRegion
' ' If rRng.ListObject.Name <> "" Then
' ' MsgBox "Table already exists", vbCritical, "Abort"
' ' Exit Sub
' ' Else: .ListObjects.Add(xlSrcRange, rRng, , xlYes).Name = "MyTable"
' ' End If
' End With
End Sub
ASKER
This appears ok but creates significant memory issues
The memory issue must be due to the amount of data being transferred.
Do the sheets contain large numbers of formulas?
ASKER
No formulas
I'll review the code and try my own version instead of thecode that you had. I'll post back later
ASKER
Thank you sir. I look forward to testing it.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
It's running now, but says "not responding". I have no indication as to what is happening.
Is there any way to make that process a little cleaner for the end user?
Is there any way to make that process a little cleaner for the end user?
It works fine for me. How much data is being transferred?
ASKER
Over 250,000 records
ASKER
I'll be at work in 8 hours and can check the results against real data again then.
Thanks very much for your help!
Thanks very much for your help!
I think it is just the sheer amount of data
ASKER
Yeah but the screen shouldn't go white and not display any kind of progress indicator. That sounds like a memory issue that could be managed within the code so that what the customer sees is descriptive enough for them not to think of that the system has hung when it hasn't. After all, the message we are trying to overcome is the one that very clearly states "not responding". This does not give the end user a very confident feeling.
It doesn't happen when I run it but I have only a small amount of sample data. You are working with over 250,000 records which is a vast amount for Excel to work with. Does the problem occur with a smaller number of records?
ASKER
No it doesn't. The macro does finish, which is good, but it would be great to have the system not appear to be hung.