Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Name Conflict using Ron De Bruin's RDB_Merge_Data_Browse
Hi everybody,
I've been using RDB_Merge_Data_Browse to collate data from all sorts of workbooks and find it invaluable. The problem I have now is that the workbooks I'm pulling data from have lots of Names (mainly Data Val) to simplify data entry for users. When I run the macro I get a dialogue box saying that a name in the sheet I want to copy is the same as one in the destination sheet and do I want to use this version of the name. Is there anyway to get round this by not copying range names over to the dest sheet or just answering yes to each dialogue box within the code? I'm posting RDBs code here Sub RDB_Merge_Data_Browse() Dim myFiles As Variant Dim myCountOfFiles As Long Dim oApp As Object Dim oFolder As Variant Set oApp = CreateObject("Shell.Application") 'Browse to the folder Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512) If Not oFolder Is Nothing Then myCountOfFiles = Get_File_Names( _ MyPath:=oFolder.Self.Path, _ Subfolders:=False, _ ExtStr:="*.xl*", _ myReturnedFiles:=myFiles) If myCountOfFiles = 0 Then MsgBox "No files that match the ExtStr in this folder" Exit Sub End If Get_Data _ FileNameInA:=True, _ PasteAsValues:=True, _ SourceShName:="", _ SourceShIndex:=1, _ SourceRng:="A1:G1", _ StartCell:="", _ myReturnedFiles:=myFiles End If End Sub Sub Get_Data(FileNameInA As Boolean, PasteAsValues As Boolean, SourceShName As String, _ SourceShIndex As Integer, SourceRng As String, StartCell As String, myReturnedFiles As Variant) Dim SourceRcount As Long Dim SourceRange As Range, destrange As Range Dim mybook As Workbook, BaseWks As Worksheet Dim rnum As Long, CalcMode As Long Dim SourceSh As Variant Dim sh As Worksheet Dim I As Long 'Change ScreenUpdating, Calculation and EnableEvents With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With 'Add a new workbook with one sheet named "Combine Sheet" Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1) BaseWks.Name = "Combine Sheet" 'Set start row for the Data rnum = 1 'Check if we use a named sheet or the index If SourceShName = "" Then SourceSh = SourceShIndex Else SourceSh = SourceShName End If 'Loop through all files in the array(myFiles) For I = LBound(myReturnedFiles) To UBound(myReturnedFiles) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(myReturnedFiles(I)) On Error GoTo 0 If Not mybook Is Nothing Then If LCase(SourceShName) < "all" Then 'Set SourceRange and check if it is a valid range On Error Resume Next If StartCell < "" Then With mybook.Sheets(SourceSh) Set SourceRange = .Range(StartCell & ":" & RDB_Last(3, .Cells)) 'Test if the row of the last cell = then the row of the StartCell If RDB_Last(1, .Cells) < .Range(StartCell).Row Then Set SourceRange = Nothing End If End With Else With mybook.Sheets(SourceSh) Set SourceRange = Application.Intersect(.UsedRange, ..Range(SourceRng)) End With End If If Err.Number 0 Then Err.Clear Set SourceRange = Nothing Else 'if SourceRange use all columns then skip this file If SourceRange.Columns.Count = BaseWks.Columns.Count Then Set SourceRange = Nothing End If End If On Error GoTo 0 If Not SourceRange Is Nothing Then 'Check if there enough rows to paste the data SourceRcount = SourceRange.Rows.Count If rnum + SourceRcount = BaseWks.Rows.Count Then MsgBox "Sorry there are not enough rows in the sheet to paste" mybook.Close savechanges:=False BaseWks.Parent.Close savechanges:=False GoTo ExitTheSub End If 'Set the destination cell If FileNameInA = True Then Set destrange = BaseWks.Range("B" & rnum) With SourceRange BaseWks.Cells(rnum, "A"). _ Resize(.Rows.Count).Value = myReturnedFiles(I) End With Else Set destrange = BaseWks.Range("A" & rnum) End If 'Copy/paste the data If PasteAsValues = True Then With SourceRange Set destrange = destrange. _ Resize(.Rows.Count, ..Columns.Count) End With destrange.Value = SourceRange.Value Else SourceRange.Copy destrange End If rnum = rnum + SourceRcount End If 'Close the workbook without saving mybook.Close savechanges:=False Else 'Loop through all sheets in mybook For Each sh In mybook.Worksheets 'Set SourceRange and check if it is a valid range On Error Resume Next If StartCell < "" Then With sh Set SourceRange = .Range(StartCell & ":" & RDB_Last(3, .Cells)) If RDB_Last(1, .Cells) < .Range(StartCell).Row Then Set SourceRange = Nothing End If End With Else With sh Set SourceRange = Application.Intersect(.UsedRange, .Range(SourceRng)) End With End If If Err.Number 0 Then Err.Clear Set SourceRange = Nothing Else 'if SourceRange use almost all columns then skip this file If SourceRange.Columns.Count BaseWks.Columns.Count - 2 Then Set SourceRange = Nothing End If End If On Error GoTo 0 If Not SourceRange Is Nothing Then 'Check if there enough rows to paste the data SourceRcount = SourceRange.Rows.Count If rnum + SourceRcount = BaseWks.Rows.Count Then MsgBox "Sorry there are not enough rows in the sheet to paste" mybook.Close savechanges:=False BaseWks.Parent.Close savechanges:=False GoTo ExitTheSub End If 'Set the destination cell If FileNameInA = True Then Set destrange = BaseWks.Range("C" & rnum) With SourceRange BaseWks.Cells(rnum, "A"). _ Resize(.Rows.Count).Value = myReturnedFiles(I) BaseWks.Cells(rnum, "B"). _ Resize(.Rows.Count).Value = sh.Name End With Else Set destrange = BaseWks.Range("A" & rnum) End If 'Copy/paste the data If PasteAsValues = True Then With SourceRange Set destrange = destrange. _ Resize(.Rows.Count, ..Columns.Count) End With destrange.Value = SourceRange.Value Else SourceRange.Copy destrange End If rnum = rnum + SourceRcount End If Next sh 'Close the workbook without saving mybook.Close savechanges:=False End If End If 'Open the next workbook Next I 'Set the column width in the new workbook BaseWks.Columns.AutoFit ExitTheSub: 'Restore ScreenUpdating, Calculation and EnableEvents With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With End Sub There is more code and I'm betting that I've posted the wrong bits. If anybody could help that would be brilliant. Thank you -- Mifty |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Name Conflict using Ron De Bruin's RDB_Merge_Data_Browse
Do you copy only values ?
-- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Mifty" wrote in message ... Hi everybody, I've been using RDB_Merge_Data_Browse to collate data from all sorts of workbooks and find it invaluable. The problem I have now is that the workbooks I'm pulling data from have lots of Names (mainly Data Val) to simplify data entry for users. When I run the macro I get a dialogue box saying that a name in the sheet I want to copy is the same as one in the destination sheet and do I want to use this version of the name. Is there anyway to get round this by not copying range names over to the dest sheet or just answering yes to each dialogue box within the code? I'm posting RDBs code here Sub RDB_Merge_Data_Browse() Dim myFiles As Variant Dim myCountOfFiles As Long Dim oApp As Object Dim oFolder As Variant Set oApp = CreateObject("Shell.Application") 'Browse to the folder Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512) If Not oFolder Is Nothing Then myCountOfFiles = Get_File_Names( _ MyPath:=oFolder.Self.Path, _ Subfolders:=False, _ ExtStr:="*.xl*", _ myReturnedFiles:=myFiles) If myCountOfFiles = 0 Then MsgBox "No files that match the ExtStr in this folder" Exit Sub End If Get_Data _ FileNameInA:=True, _ PasteAsValues:=True, _ SourceShName:="", _ SourceShIndex:=1, _ SourceRng:="A1:G1", _ StartCell:="", _ myReturnedFiles:=myFiles End If End Sub Sub Get_Data(FileNameInA As Boolean, PasteAsValues As Boolean, SourceShName As String, _ SourceShIndex As Integer, SourceRng As String, StartCell As String, myReturnedFiles As Variant) Dim SourceRcount As Long Dim SourceRange As Range, destrange As Range Dim mybook As Workbook, BaseWks As Worksheet Dim rnum As Long, CalcMode As Long Dim SourceSh As Variant Dim sh As Worksheet Dim I As Long 'Change ScreenUpdating, Calculation and EnableEvents With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With 'Add a new workbook with one sheet named "Combine Sheet" Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1) BaseWks.Name = "Combine Sheet" 'Set start row for the Data rnum = 1 'Check if we use a named sheet or the index If SourceShName = "" Then SourceSh = SourceShIndex Else SourceSh = SourceShName End If 'Loop through all files in the array(myFiles) For I = LBound(myReturnedFiles) To UBound(myReturnedFiles) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(myReturnedFiles(I)) On Error GoTo 0 If Not mybook Is Nothing Then If LCase(SourceShName) < "all" Then 'Set SourceRange and check if it is a valid range On Error Resume Next If StartCell < "" Then With mybook.Sheets(SourceSh) Set SourceRange = .Range(StartCell & ":" & RDB_Last(3, .Cells)) 'Test if the row of the last cell = then the row of the StartCell If RDB_Last(1, .Cells) < .Range(StartCell).Row Then Set SourceRange = Nothing End If End With Else With mybook.Sheets(SourceSh) Set SourceRange = Application.Intersect(.UsedRange, .Range(SourceRng)) End With End If If Err.Number 0 Then Err.Clear Set SourceRange = Nothing Else 'if SourceRange use all columns then skip this file If SourceRange.Columns.Count = BaseWks.Columns.Count Then Set SourceRange = Nothing End If End If On Error GoTo 0 If Not SourceRange Is Nothing Then 'Check if there enough rows to paste the data SourceRcount = SourceRange.Rows.Count If rnum + SourceRcount = BaseWks.Rows.Count Then MsgBox "Sorry there are not enough rows in the sheet to paste" mybook.Close savechanges:=False BaseWks.Parent.Close savechanges:=False GoTo ExitTheSub End If 'Set the destination cell If FileNameInA = True Then Set destrange = BaseWks.Range("B" & rnum) With SourceRange BaseWks.Cells(rnum, "A"). _ Resize(.Rows.Count).Value = myReturnedFiles(I) End With Else Set destrange = BaseWks.Range("A" & rnum) End If 'Copy/paste the data If PasteAsValues = True Then With SourceRange Set destrange = destrange. _ Resize(.Rows.Count, .Columns.Count) End With destrange.Value = SourceRange.Value Else SourceRange.Copy destrange End If rnum = rnum + SourceRcount End If 'Close the workbook without saving mybook.Close savechanges:=False Else 'Loop through all sheets in mybook For Each sh In mybook.Worksheets 'Set SourceRange and check if it is a valid range On Error Resume Next If StartCell < "" Then With sh Set SourceRange = .Range(StartCell & ":" & RDB_Last(3, .Cells)) If RDB_Last(1, .Cells) < .Range(StartCell).Row Then Set SourceRange = Nothing End If End With Else With sh Set SourceRange = Application.Intersect(.UsedRange, .Range(SourceRng)) End With End If If Err.Number 0 Then Err.Clear Set SourceRange = Nothing Else 'if SourceRange use almost all columns then skip this file If SourceRange.Columns.Count BaseWks.Columns.Count - 2 Then Set SourceRange = Nothing End If End If On Error GoTo 0 If Not SourceRange Is Nothing Then 'Check if there enough rows to paste the data SourceRcount = SourceRange.Rows.Count If rnum + SourceRcount = BaseWks.Rows.Count Then MsgBox "Sorry there are not enough rows in the sheet to paste" mybook.Close savechanges:=False BaseWks.Parent.Close savechanges:=False GoTo ExitTheSub End If 'Set the destination cell If FileNameInA = True Then Set destrange = BaseWks.Range("C" & rnum) With SourceRange BaseWks.Cells(rnum, "A"). _ Resize(.Rows.Count).Value = myReturnedFiles(I) BaseWks.Cells(rnum, "B"). _ Resize(.Rows.Count).Value = sh.Name End With Else Set destrange = BaseWks.Range("A" & rnum) End If 'Copy/paste the data If PasteAsValues = True Then With SourceRange Set destrange = destrange. _ Resize(.Rows.Count, .Columns.Count) End With destrange.Value = SourceRange.Value Else SourceRange.Copy destrange End If rnum = rnum + SourceRcount End If Next sh 'Close the workbook without saving mybook.Close savechanges:=False End If End If 'Open the next workbook Next I 'Set the column width in the new workbook BaseWks.Columns.AutoFit ExitTheSub: 'Restore ScreenUpdating, Calculation and EnableEvents With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With End Sub There is more code and I'm betting that I've posted the wrong bits. If anybody could help that would be brilliant. Thank you -- Mifty |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Name Conflict using Ron De Bruin's RDB_Merge_Data_Browse
Perhaps if you add this to the APPLICATION controls....
Top of the macro: Application.DisplayAlerts = False Bottom of the macro: Application.DisplayAlerts = True See if that helps any... -- "Actually, I *am* a rocket scientist." -- JB (www.MadRocketScientist.com) Your feedback is appreciated, click YES if this post helped you. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Name Conflict using Ron De Bruin's RDB_Merge_Data_Browse
Hi Ron,
Apologies - no - I posted your original code. I have some data that doesn't copy over correctly as values, if memory serves it's date of birth. Here is actual piece of code FileNameInA:=True, _ PasteAsValues:=False, _ SourceShName:="Data1", _ SourceShIndex:=1, _ SourceRng:="A:I", _ StartCell:="A4", _ myReturnedFiles:=myFiles Sorry about that! :-) -- Mifty "Ron de Bruin" wrote: Do you copy only values ? -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Name Conflict using Ron De Bruin's RDB_Merge_Data_Browse
Hi JB,
Thanks for that, it's done the trick! Cheers -- Mifty "JBeaucaire" wrote: Perhaps if you add this to the APPLICATION controls.... Top of the macro: Application.DisplayAlerts = False Bottom of the macro: Application.DisplayAlerts = True See if that helps any... -- "Actually, I *am* a rocket scientist." -- JB (www.MadRocketScientist.com) Your feedback is appreciated, click YES if this post helped you. |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Name Conflict using Ron De Bruin's RDB_Merge_Data_Browse
Hi Mifty
To avoid this copy as values and after the macro is ready format the date column as you want (manual or also with code) -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Mifty" wrote in message ... Hi Ron, Apologies - no - I posted your original code. I have some data that doesn't copy over correctly as values, if memory serves it's date of birth. Here is actual piece of code FileNameInA:=True, _ PasteAsValues:=False, _ SourceShName:="Data1", _ SourceShIndex:=1, _ SourceRng:="A:I", _ StartCell:="A4", _ myReturnedFiles:=myFiles Sorry about that! :-) -- Mifty "Ron de Bruin" wrote: Do you copy only values ? -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Name Conflict using Ron De Bruin's RDB_Merge_Data_Browse
Hi Ron,
So it's because I'm not copying values - ahh! So are there any circumstances in which you would change the code to say PasteAsValues:=False, _ ? And would you disable alerts? Cheers -- Mifty "Ron de Bruin" wrote: Hi Mifty To avoid this copy as values and after the macro is ready format the date column as you want (manual or also with code) -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Mifty" wrote in message ... Hi Ron, Apologies - no - I posted your original code. I have some data that doesn't copy over correctly as values, if memory serves it's date of birth. Here is actual piece of code FileNameInA:=True, _ PasteAsValues:=False, _ SourceShName:="Data1", _ SourceShIndex:=1, _ SourceRng:="A:I", _ StartCell:="A4", _ myReturnedFiles:=myFiles Sorry about that! :-) -- Mifty "Ron de Bruin" wrote: Do you copy only values ? -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm . |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Name Conflict using Ron De Bruin's RDB_Merge_Data_Browse
I always use True myself because you can also have problems with formulas
But you can also use pastespecial to do the copy/paste You can copy the number format also so your dates looks OK I think I will add that the next time I update the page -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Mifty" wrote in message ... Hi Ron, So it's because I'm not copying values - ahh! So are there any circumstances in which you would change the code to say PasteAsValues:=False, _ ? And would you disable alerts? Cheers -- Mifty "Ron de Bruin" wrote: Hi Mifty To avoid this copy as values and after the macro is ready format the date column as you want (manual or also with code) -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Mifty" wrote in message ... Hi Ron, Apologies - no - I posted your original code. I have some data that doesn't copy over correctly as values, if memory serves it's date of birth. Here is actual piece of code FileNameInA:=True, _ PasteAsValues:=False, _ SourceShName:="Data1", _ SourceShIndex:=1, _ SourceRng:="A:I", _ StartCell:="A4", _ myReturnedFiles:=myFiles Sorry about that! :-) -- Mifty "Ron de Bruin" wrote: Do you copy only values ? -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm . |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Name Conflict using Ron De Bruin's RDB_Merge_Data_Browse
Thank you Ron :-)
I'll look out for the update. I'd be lost without your website and especially your example workbooks :-) Thank you again -- Mifty |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Ron de Bruin's Google Add-in 6.01 | Excel Discussion (Misc queries) | |||
Ron de Bruin's Copy to Worksheets | Excel Programming | |||
Help Using Ron De Bruin's RDB_Merge_Data Macro | Excel Programming | |||
Ron de Bruin's Calendar | Excel Discussion (Misc queries) | |||
Ron de Bruin's Calendar | Excel Discussion (Misc queries) |