Solved: Merge Excel file through validation

[Noelfer1977]

Hi,

I have a script, which used to merge all the data from different excel file into a single excel file. I need to merge all the data with a certain required condition. Here is the example data:

Arun.xls
Emp ID Name Records Date
X123 Arun 120 8/1/2008
X123 Arun 145 8/2/2008
X123 Arun 130 8/3/2008

Banu.xls
Emp ID Name Records Date
X123 Banu 115 8/1/2008
X123 Banu 125 8/2/2008
X123 Banu 140 8/3/2008

The above are individual file and below is the merged file (script is given in the bottom):

Merge.xls
X123 Arun 120 8/1/2008
X123 Arun 145 8/2/2008
X123 Arun 130 8/3/2008
X123 Banu 115 8/1/2008
X123 Banu 125 8/2/2008
X123 Banu 140 8/3/2008

Script:
---------------------------------------------------------------------
Sub merge()
Dim book As Workbook
Dim sheet As Worksheet
Dim path
Dim file
Dim keyer_name
Dim prod_flag
path = Application.InputBox("Enter Path")

file = Dir(path & "\*.xls")
y = 7
t = 0
Do While file <> ""
Set book = Excel.Workbooks.Open(path & "\" & file)
On Error GoTo 100
prod_flag = 0
Set sheet = book.Sheets.Item(1)

x = 7

Do While sheet.Cells(x, "Q") <> ""
For c = 1 To 26
Sheet1.Cells(y, c) = sheet.Cells(x, c)
Next
x = x + 1
y = y + 1
prod_flag = prod_flag + 1

Loop

prod_flag = 0
book.Close (0)
100
file = Dir
Loop
s = MsgBox("Merging Completed", vbInformation)
End Sub

---------------------------------------------------------------------
The above script merge all the data into a single file. But i need some condition before we merge the data.

For example, if date 8/1/2008 is given before merging (through 'Inputbox') then it should merge only 8/1/2008 and not 8/2/2008 or any other dates.

Please help in this regard.

Thanks,
Noel Fernandez

[mdmackillop]

Hi Noel
I try to avoid "standard" replies but...
Welcome to VBAX.
A sample file would make your requirements easier to follow. You can post a file using Manage Attachments in the Go Advanced reply section
Regards
MD

[Noelfer1977]

Hi,

As rquired by you, i have attached the sample data. The data contains 3 files:

Arun.xls
Banu.xls
Merge.xls

Arun and Banu are the files to be merged into merge.xls file. Arun and Banu files should be in a folder. Open the merge.xls file and run the script. It will ask you the path. Enter the path where arun and Banu files are located.

The above script merge all the data into a single file. But i need some condition before we merge the data.

For example, if date 8/1/2008 is given before merging (through 'Inputbox') then it should merge only 8/1/2008 and not 8/2/2008 or any other dates.

Please let me know if anymore clarification is required from my side.

Thanks,
Noel Fernandez

[mdmackillop]

Hi Noel,
Try to use more meaningful names for your variables. Book and Sheet can cause confusion and make code hard to follow.
In your submitted code, consider copy and paste rather than writing each cell in turn.


Option Explicit
Sub merge()
Dim wbSource As Workbook
Dim Source As Range
Dim wsTarget As Worksheet
Dim path As String
Dim pth As String
Dim file As String
Dim Dte As String

Set wsTarget = ActiveSheet
pth = ActiveWorkbook.path
pth = Left(pth, InStr(4, pth, "\"))
path = BrowseForFolder(pth)
file = Dir(path & "\*.xls")
Dte = InputBox("Enter date", , "8/1/2008")
Do While file <> ""
Set wbSource = Excel.Workbooks.Open(path & "\" & file)
On Error GoTo 100

Set Source = wbSource.Sheets(1).Range("A1").CurrentRegion
Source.Range("E1").AutoFilter Field:=5, Operator:= _
xlFilterValues, Criteria2:=Array(2, Dte)
Source.Offset(1).Resize(Source.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy wsTarget.Cells(Rows.Count, 1).End(xlUp).Offset(1)
wbSource.Close (0)
100
file = Dir
Loop
MsgBox "Merging Completed", vbInformation

End Sub

Function BrowseForFolder(Optional OpenAt As Variant) As Variant

'http://www.vbaexpress.com/kb/getarticle.php?kb_id=284

'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level

Dim ShellApp As Object

'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.path
On Error GoTo 0

'Destroy the Shell Application
Set ShellApp = Nothing

'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename (file://servername/sharename). All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select

Exit Function

Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False

End Function

[Noelfer1977]

Hi,

While doing merging on different excel into single excel, i am getting error msg. Attaching you the screen shot.

Here is the script of that:


Code removed.


Kindly help me on this.

Thanks,
Noel Fernandez

[mdmackillop]

A 2007 incompatibility.
Change this
Source.Range("E1").AutoFilter Field:=5, Operator:= _
xlFilterValues, Criteria2:=Array(2, Dte)
to this

Source.Range("E1").AutoFilter Field:=5, Criteria1:=Dte

BTW, There is no point in posting code that is already posted unless you have made changes; in which case they should be marked.
When you do post code, use the VBA button to format it as shown.

[Noelfer1977]

Hi,

After successful completion of macro -- on my merge file, I am getting date column in error as follows:

S# Emp ID Name Records Date
9 X123 Arun 52 #VALUE!
9 X120 Banu 109 #VALUE!

Please help me on this.

Thanks,
Noel

[mdmackillop]

Change the Copy routine to

Source.Offset(1).Resize(Source.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
wsTarget.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlValues

[Noelfer1977]

Hi,

With this same script, i worked with different data. But at the each time, i am getting msg as "copied into clipboard, save yes no cancel" and another error msg as "no rows found" and skips the process without completion of rest of the files.

(Attaching you the screen shot).

Please help.

Thanks,
Noel

[mdmackillop]

Try stepping through the code to determine where the error occurs. Do the date fields differ in your second test? Please attach some of your actual data.

[Noelfer1977]

Hi,

As required by you, attached is the sample file contains:

Merge Master.xls (master file having coding script)
Kathy.xls
Kim.xls
Liz.xls
Tom.xls

Kindly look into this.

Thanks,
Noel

[mdmackillop]

Sub merge()
Dim wbSource As Workbook
Dim Source As Range
Dim wsTarget As Worksheet
Dim path As String
Dim pth As String
Dim file As String
Dim Dte As String

Application.ScreenUpdating = False

Set wsTarget = ActiveSheet
pth = ActiveWorkbook.path
pth = Left(pth, InStr(4, pth, "\"))
path = BrowseForFolder(pth)
file = Dir(path & "\*.xls")

Dte = InputBox("Enter date", , "8/1/2008")
Do While file <> ""
Set wbSource = Excel.Workbooks.Open(path & "\" & file)
On Error GoTo 100

Set Source = wbSource.Sheets(1).Range("A7").CurrentRegion

Source.Range("U7").AutoFilter Field:=21, Criteria1:=Dte
Source.Offset(1).Resize(Source.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
wsTarget.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlValues
Application.CutCopyMode = False

wbSource.Close (0)
100
file = Dir
Loop
Range("A2").Select
Application.ScreenUpdating = True
MsgBox "Merging Completed", vbInformation

End Sub

[Noelfer1977]

Hi,

We?re still getting the same error msg.

Example,

There are 4files we need to merge these into ?Merge.xls? (having script in this file) as below:
Kathy.xls
Kim.xls
Liz.xls
Tom.xls

For the entire above xls file, we have date range from 8/1/2008 to 8/6/2008. If we have given 8/5/2008 (through Input Box) while merging, and Kim.xls & Liz.xls is not having a date of 8/5/2008, we?re getting error msg as ?No Cells were Found?, Continue, End, Debug. If we click debug, error screen shot is appearing.

Please see to this.

Thanks.

[Noelfer1977]

Hi,

I am still having problem with the merging. If on a particular date a person is not working then the merging shows error. Can you please help me out with this last issue?


Thanks.

[mdmackillop]

Sub merge()
Dim wbSource As Workbook
Dim Source As Range
Dim wsTarget As Worksheet
Dim path As String
Dim pth As String
Dim file As String
Dim Dte As String

Application.ScreenUpdating = False
Set wsTarget = ActiveSheet
pth = ActiveWorkbook.path
pth = Left(pth, InStr(4, pth, "\"))
path = BrowseForFolder(pth)
file = Dir(path & "\*.xls")

Dte = InputBox("Enter date", , "8/1/2008")
Do While file <> ""
Set wbSource = Excel.Workbooks.Open(path & "\" & file)
On Error GoTo 100

Set Source = wbSource.Sheets(1).Range("A7").CurrentRegion

Source.Range("U7").AutoFilter Field:=21, Criteria1:=Dte
On Error Resume Next
Source.Offset(1).Resize(Source.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
If Err = 1004 Then GoTo 100
wsTarget.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlValues
Application.CutCopyMode = False
100
wbSource.Close (0)
file = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Merging Completed", vbInformation

End Sub

[Noelfer1977]

Hi,

Finally we have got the perfect result. This would have not been possible without you. Thanks for your time and patience.


Noel Fernandez.