Name range macro conflict Results

Hi,

I have a couple of sheets, one with a week on week budget, the other I want
to pull the budget data on.
I've named each weeks budget and tried to use the macro:

Dim Week, budgets
Week = InputBox("What budget week do you want to display?", "Budget Week")

Select Case Week
Case Is = 1
budgets = Sheets("Budget").Select
Application.Goto Reference:="WK1"

Case Is = 2
budgets = Sheets("Budget").Select
Application.Goto Reference:="WK2"

Case Else
Area = "but you don't seem to know your Budget week"

End Select

Range("I38").Select

Application.Goto Reference:=Worksheets("Budget").Range("Budgets"), _
scroll:=True

Selection.Copy
Sheets("Summary by Plant").Select
Range("I38").Select
ActiveSheet.Paste

Can't seem to find the right code to pull in the named range.

Any ideas please?

J

Hi,

I have a couple of sheets, one with a week on week budget, the other I want
to pull the budget data on.
I've named each weeks budget and tried to use the macro:

Dim Week, budgets
Week = InputBox("What budget week do you want to display?", "Budget Week")

Select Case Week
Case Is = 1
budgets = Sheets("Budget").Select
Application.Goto Reference:="WK1"

Case Is = 2
budgets = Sheets("Budget").Select
Application.Goto Reference:="WK2"

Case Else
Area = "but you don't seem to know your Budget week"

End Select

Range("I38").Select

Application.Goto Reference:=Worksheets("Budget").Range("Budgets"), _
scroll:=True

Selection.Copy
Sheets("Summary by Plant").Select
Range("I38").Select
ActiveSheet.Paste

Can't seem to find the right code to pull in the named range.

Any ideas please?

J

I have two subroutines that are almost identical. They point at their respective data sets and determine the number of rows and columns that are present, then they make each column in the data set a named range based on the column header.

My problem is that they are somehow conflicting with each other. One's range is always right and the others is always wrong (row count). I know there is a conflict because the one that is wrong is always the same dimension as the one that is right.

Can someone please check out my code and tell me why they are somehow affecting each other?


	VB:
	
 
 'This sub is just to add a row to the Chart_Data sheet when the "New Week" button is pressed
 'It is called by the AddDNR_ChartData sub
Public Sub InsertNewRow() 
    Dim LastWeek As String 
    myrow = 2 
     
    Do Until Cells(myrow, 1) = "" 
        myrow = myrow + 1 
    Loop 
     
    Cells(myrow - 1, 1).Activate 'selects the last row with values
    ActiveCell.EntireRow.Copy 'copies that row
    Cells(myrow, 1).Activate 'selects new row
    ActiveSheet.Paste 'pastes copied row
    Cells(myrow - 1, 1).Activate 'selects the OLD last row with values
    ActiveCell.EntireRow.PasteSpecial xlPasteValues 'pastes values back over itself
    LastWeek = (Int(Cells(myrow, 1).Value) + 7) ' adds 7 days to the previous weeks date
     
    Cells(myrow, 1).Value = LastWeek ' and puts it in the cell
     
End Sub 
Public Sub AddDNR_ChartData() 
    Dim wb As Workbook, ws As Worksheet 
    Dim lrow As Long, lcol As Long, i As Long 
    Dim myName As String, start As String 
     
     
    Application.ScreenUpdating = False 
     
    ChartData.Unprotect Password:="6croton9" 'unprotect wksheet
     
    ChartData.Activate 
     
    Call InsertNewRow 
     ' set the row number where headings are held as a constant
     ' change this to the row number required if not row 1
    Const Rowno = 2 ' the row containing headings, which would normally be 1
     ' set the Offset as the number of rows below Rowno, where the
     ' data begins
    Const ROffset = 2 ' the number of rows below Rowno that the actual data starts
     ' set the starting column for the data, in this case 1
     ' change if the data does not start in column A
    Const Colno = 1 ' the first column containing data, again, normally column 1
     
     ' Set an Offset from the starting column, for the column number that
     ' will always have data entered, and will therefore be used in calculating lrow
     
    Const COffset = 0 ' the number of columns to the right of Colno which will always contain data
    On Error Goto CreateNames_Error 
    Set wb = ActiveWorkbook 
    Set ws = ActiveSheet 
     ' count the number of columns used in the row designated to
     ' have the header names
     
    lcol = Cells(Rowno, Columns.Count).End(xlToLeft).Column 
    lrow = ws.Cells(rows.Count, Colno).End(xlUp).Row 
    start = Cells(Rowno, Colno).Address 
     
    wb.Names.Add Name:="lcol", RefersTo:="=COUNTA($" & Rowno & ":$" & Rowno & ")" 
    wb.Names.Add Name:="lrow", RefersToR1C1:="=COUNTA(C" & Colno + COffset & ")" 
    wb.Names.Add Name:="CD_Range", RefersTo:= _ 
    "=" & start & ":INDEX($1:$65536," & "lrow," & "Lcol)" 
    For i = Colno To lcol 
         ' if a column header contains spaces, replace the space with an underscore
         ' spaces are not allowed in range names.
        myName = Replace(Cells(Rowno, i).Value, " ", "_") 
        If myName = "" Then 
             ' if column header is blank, warn the user and stop the macro at that point
             ' names will only be created for those cells with text in them.
            MsgBox "Missing Name in column " & i & vbCrLf _ 
            & "Please Enter a Name and run macro again" 
            Exit Sub 
        End If 
        wb.Names.Add Name:=myName, RefersToR1C1:= _ 
        "=R" & Rowno + ROffset - 1 & "C" & i & ":INDEX(C" & i & ",lrow)" 
         
nexti: 
    Next i 
    On Error Goto 0 
    MsgBox "CHART_DATA sheets' dynamic named range has been created" 
     
    ActiveWorkbook.RefreshAll 
    DoEvents 
    Application.ScreenUpdating = True 
     
    Exit Sub 
    Exit Sub 
CreateNames_Error: 
    MsgBox "Error " & Err.Number & " (" & Err.Description & _ 
    ") in procedure CreateNames of Module Technology4U" 
     
End Sub 
 
Public Sub AddDNR_TrackingMaster() 
    Dim wb As Workbook, ws As Worksheet 
    Dim lrow As Long, lcol As Long, i As Long 
    Dim myName As String, start As String 
     
     
    Application.ScreenUpdating = False 
     
    TrackingMaster.Unprotect Password:="6croton9" 'unprotect wksheet
     
    TrackingMaster.Activate 
     
     'Resets the last row ranges and variables
    ThisWorkbook.Names("TMlcol").Delete 
    ThisWorkbook.Names("TMlrow").Delete 
     
    lcol = 0 
    lrow = 0 
     
     ' set the row number where headings are held as a constant
     ' change this to the row number required if not row 1
    Const Rowno = 3 ' the row containing headings, which would normally be 1
     ' set the Offset as the number of rows below Rowno, where the
     ' data begins
    Const ROffset = 2 ' the number of rows below Rowno that the actual data starts
     ' set the starting column for the data, in this case 1
     ' change if the data does not start in column A
    Const Colno = 2 ' the first column containing data, again, normally column 1
     
     ' Set an Offset from the starting column, for the column number that
     ' will always have data entered, and will therefore be used in calculating lrow
     
    Const COffset = 0 ' the number of columns to the right of Colno which will always contain data
    On Error Goto CreateNames_Error 
    Set wb = ActiveWorkbook 
    Set ws = ActiveSheet 
     ' count the number of columns used in the row designated to
     ' have the header names
     
    lcol = Cells(Rowno, Columns.Count).End(xlToLeft).Column 
    lrow = ws.Cells(rows.Count, Colno).End(xlUp).Row 
    start = Cells(Rowno, Colno).Address 
     
    wb.Names.Add Name:="TMlcol", RefersTo:="=COUNTA($" & Rowno & ":$" & Rowno & ")" 
    wb.Names.Add Name:="TMlrow", RefersToR1C1:="=COUNTA(C" & Colno + COffset & ")" 
    wb.Names.Add Name:="TM_Range", RefersTo:= _ 
    "=" & start & ":INDEX($1:$65536," & "lrow+1," & "Lcol+1)" 
    For i = Colno To lcol 
         ' if a column header contains spaces, replace the space with an underscore
         ' spaces are not allowed in range names.
        myName = Replace(Cells(Rowno, i).Value, " ", "_") 
        If myName = "" Then 
             ' if column header is blank, warn the user and stop the macro at that point
             ' names will only be created for those cells with text in them.
            MsgBox "Missing Name in column " & i & vbCrLf _ 
            & "Please Enter a Name and run macro again" 
            Exit Sub 
        End If 
        wb.Names.Add Name:=myName, RefersToR1C1:= _ 
        "=R" & Rowno & "C" & i & ":INDEX(C" & i & ",lrow+1)" 
         
nexti: 
    Next i 
    On Error Goto 0 
    MsgBox "Tracking Master sheet's dynamic named range has been created" 
     
    ActiveWorkbook.RefreshAll 
    DoEvents 
    Application.ScreenUpdating = True 
     
    Exit Sub 
CreateNames_Error: 
    MsgBox "Error " & Err.Number & " (" & Err.Description & _ 
    ") in procedure CreateNames of Module Technology4U" 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Hello all.

I'm trying to create a macro [or a couple of macros] that when run, dynamically add a row [with formula] to the last row in a range.

The ranges are in the same column [C] in the same worksheet.

MACRO 1
Say I have a NAMED RANGE [SECTION 1] C2:C10 and the new row would always be added to the bottom to C11, C12 ...
I would like to insert the R1C1 Formula: FormulaR1C1 = "=RC[-2]-RC[-1]" into the last row in the range

MACRO 2
If I also have another NAMED RANGE [SECTION 2] C20:C30.
I would like to insert the R1C1 Formula: FormulaR1C1 = "=RC[-3]/RC[-2]-1" into the last row in the range

My Question is how can I independently insert rows into both Names Ranges without a conflict?

Whatever I have tried, SECTION 1 pushes SECTION 2 down so that eventually it stops SECTION 2 From working.

Sub Note: I've tried to define SECTION 1 as "=OFFSET(Sheet1!$C$2,0,0,COUNTA(Sheet1!$C:$C),1)", to help keep it expanding, but not sure if this helps as I can't seem to apply it to the SECTION 2

Thanks to any speculation, hope I have not made it sound more complicated than it is!

johnny

Short version: I am attempting to find the language to execute a macro the first time the right mouse button is pressed by the user. It needs to execute only once per instance of the file being open. Below is the long version of my issue

I am attempting to assign a macro to a drop down box, but I'm having a strange issue. We are using third party software to publish data through Excel to the internet, so I assume this is causing the issue. Issue -->The drop down box is populated by a named range, but the range fails to expand and contract properly when the macro is assigned to the box. Is there a creative way to assign the macro to the drop down box after the first click of the mouse by the user? I know how to use a seperate macro to assign the main macro, but what would the trigger language be? I would only want it to assign once per instance of opening the spreadsheet, but not necessarily upon opening, as the third party software is populating data and there could be a conflict. I wouldn't want a button either, as I would prefer a cleaner look.

Thanks for any help!

Chris

I have a macro that is working network wide on a variety of computers but will not work on newly installed computer. I have identified the snippet of code that is not working. It is as follows:

Sheets("2008 drivers sch").Select
Dim rRange As Range
On Error Resume Next
Application.DisplayAlerts = False
Set rRange = Application.InputBox(Prompt:= _
"Please select a range to be copied.", _
Title:="SPECIFY RANGE", Left:=10, Top:=10, Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True
If rRange Is Nothing Then
Exit Sub
Else
rRange.Copy
End If

This section of the code is designed so that a user highlights a range of cells and the macro copies it to be later pasted into a different sheet. The macro requests the user input of the range as required and appears to try to paste it in the next step as required, however, the code listed here does not seem to be copying the named range.

The new computer has Windows XP SP2 installed. It originally had SP3 installed and the macro was not working so I rolled it back to SP2 since all of the other computers have SP2. However, rolling it back did not help at all.

Does anyone see anything in the code that would point to a conflict with any recent Office or Windows updates? Since it works on all other computers except this one it would seem logical to me that it is a system issue and not a specific code issue.

Thanks,
Jason

Can't figure out why the following stopped working -
worked for about 40 entries and then returned an error
msg, deleting and recreating then doesn't work properly.
I have a column of combined city state and zip, looks
like this: Chicago, IL 60606

I want to get the state and zip away from the city, and
put the zip in an adjacent column. I use the relative
toggle button when I record the macro. As I go down the
column, the macro puts the results in the current
(correct) cell locations, but it is replicating the city
and zip that were in the cell used when I recording the
macro.

I have gone into options to deactivate 'edit' and other
settings that may interfere. When recording the macro, I
use the tool bar buttons instead of shortcut keys ctrl-x
and ctrl-v, thinking that may be a problem. I have
rebooted and restarted with the original file, but it
seem the macro somehow corrupts after a little use and
can't get a new macro to work. Even took it home and
tried it in Excel 2003, and does the same thing there
(something get embedded in the spreadsheet that
conflicts?)

My recording process was to click the relative button,
start recording, name the macro, hit f2, hold down shift
while hitting left-arrow 5 times (highlites zipcode),
click on 'cut', backspace 5 times to delete the ", IL ",
tab twice to move over 2 columns, click on 'paste', hit
return which moves the active cell down a row and over to
one cell below my start point, and stop recording.
----------------------------------------------------------
-------------
-
Sub q()
'
' q Macro
' Macro recorded 11/24/2004 by N M Burton
'
' Keyboard Shortcut: Ctrl+q
'
ActiveCell.FormulaR1C1 = "Banks"
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, -2).Range("A1").Select
End Sub
----------------------------------------------------------
-------------
Debug tells me the problem is with
the "ActiveSheet.Paste" command.

Any ideas?

Thanks. N Burton, Wisconsin

Please help!! It's a nightmare to see the macro terminates itself without any error prompt....

Workbook A & B are basically identical, they both have the same macro & name ranges.
I use A to generate reports and want to move the report sheets to B. (Sounds funny... but it's a request)
The report sheets are generated thus do not contain any nameranges but don't know why the name conflict message will always prompt, so I must disable DisplayAlert
Here's my code:
Sub MoveSheet()

Dim filename As String
Dim dataWs  As Worksheet
filename = "C:tempworkbookB.xls"
Set dataWs = workbook(filename).sheets("Data")

for num = 1 to 5Set ws = Thisworkbook.Worksheets("report" & num)

Application.DisplayAlerts = False
debug.print "begin move " & ws.name
ws.Move after:=dataWs    'Macro stops after running this line!
debug.print "moved " & ws.name
Application.DisplayAlerts = Truenext num

End Sub
I could only get "begin move report1" in the immediate window,
but never seen the "moved" debug print nor other report's debug print...
I've tried to use COPY instead of MOVE, but same problem occur...
I'm completely stuck!
Great Thanks in advance for any suggestion!

I've got some VB code that takes information from workbook and pastes it
another as shown:

Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

The problem is that during pasting a messagebox comes up that says:

A formula or sheet you want to move or copy contains the name 'XXX', which
already exists on the destination worksheet. Do you want to use this version
of the name?
-To use the name as defined in the destination sheet, click yes.
-To rename the range referred to in the formula or worksheet, click No,
and enter a new name in the Name Conflict dialog box.

XXX is a range name. Since there are about 30 named ranges in the
spreadsheet, the user has to click yes 30 times (once for each range name).
How can I avoid having the user do this?

Okay, here's another stumper!

I created a template for inputting and charting data which will be used for numerous chemicals. Template contains about 10 defined names (lets say, lot, beg1, beg2, mid1, mid2, end1, end2, SD2, SD3). These are dynamic ranges. Multiple copies of these templates will be put into a single workbook, each for a different chemical. I therefore need to update each of these names so that there's no conflict. My thought is to add a prefix to each name, so if the chemical is salt, the defined names might be saltlot, saltbeg1,saltbeg2.....

Am I correct in assuming there's no way (no easy way) to do this without macros? The code for this is also beyond me. Any help out there?

Thanks in advance.
ChemistB

Hello there
I have got a sp which take a datatype of @FaxDoc varbinary
Now I wanted to set the parameters from vba code the VBA Function as below:
)
 
Dim strConnection As String
 Dim oDB As ADODB.Connection
 Dim oCmd As ADODB.Command
 strConnection = "Provider=SQLOLEDB.1;Data Source=" & DataSource & ";Integrated Security=SSPI;Persist
Security Info=False;Initial Catalog=" & DatabaseNameFax & ";Application Name=""Receipt
Macro"""
 Set oDB = New ADODB.Connection
 oDB.Open strConnection
 Set oCmd = New ADODB.Command
 With oCmd
 Set .ActiveConnection = oDB
 .CommandType = adCmdStoredProc
 .CommandText = "Sp_Faxinput"
 .Parameters.Append .CreateParameter("@FaxNumber", adVarWChar, adParamInput, 100, FaxNumber)
 .Parameters.Append .CreateParameter("@RecipientName", adVarWChar, adParamInput, 1000, "RecipientName ")
'Block and Slide Ids are private - not intended for the customer
 .Parameters.Append .CreateParameter("@Subject", adVarWChar, adParamInput, 1000, "Subject")
 
.Parameters.Append .CreateParameter("@FaxDoc",advarByte, adParamInput, 10000, faxDoc)
 .NamedParameters = True
 .Execute
 End With
 Set oCmd = Nothing
 End Function
I debug the code when it come to .Parameters.Append .CreateParameter("@FaxDoc",advarByte, adParamInput, 10000, faxDoc)
It through increate data type.
What is the right data type should use to pass a value of faxDoc() As Byte

I have posted a few questions on the board so far, and the members have been extremely helpful......
So, I figured I would toss this out there and see if you can help.

Ok, this one is a little tricky (at least for me).

I have a data source sheet (SHEET1) that is updated using a table query. Within that update macro I have added a date stamp that displays when the report was generated.
I have written a 2nd macro that will add reports (worksheets) to a workbook by copying the source sheet. I then have the reports renamed to the date stamp displayed on the source sheet (SHEET1).

Here is the current code I use.

Code:
Sub Add_Report2()
'Add_Report Macro
Worksheets.Add
With ActiveSheet
    .Name = Format(Sheets("Report").Range("A5"), "dd mmm yy")
    .Move After:=Sheets(Sheets.Count)
End With
    Sheets("Report").Range("A1:O65536").Copy
    Sheets(Sheets.Count).Range("A1").Select
    ActiveSheet.Paste
    ActiveSheet.Select
End Sub
It is dynamic enough to do the basics. The problem that I am running into now (which you might already see), is:

If I am to run the code twice in one day there is a naming conflict.
I have already setup the msgbox code and the if statement framework that will give the user the choice to overwrite the report if he/she chooses(I think).

Here is the code for that:
Code:
Sub RecallConfirm()
'The purpose of this procedure is to keep the user...
'...from accidently overwriting the report
ActiveSheet.Select
'Change this If Statement to find a sheet with the same name
If Range("A2").Value = Range("B2").Value Then
'If it exists this msg will appear
response = msgbox("Report already Exists. Do you want to replace it?", vbYesNo + vbQuestion, "Confirmation")
If response = vbYes Then
'If you respond yes then the current sheet with that name will be deleted
'and the Add_Report2() procedure above will continue
msgbox ("The Report has been overwritten")
Else
msgbox ("You have cancelled this action")
End If
End If
End Sub

To the point, how do I look for a name that will change.
I want to compare the current date name displayed in the code to all current sheet names (I think this will work in theory).

The question is what does the code look like for something like that??
Thanks for taking the time.....

I am working on a .xls that uses a cell from another sheet and adds a value. This cell (O2) is then used to run a macro to change the sheet name as follows (workbook level):

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Target.Address = "$O$2" Then Sh.Name = Target
If Err Then
MsgBox "Conflict - Duplicative week number - Please re-enter week number."
End If
End Sub

O2 is calculating properly, but the macro is not running in that cell unless I physically press ENTER in the formula bar. Is there any way I can have the macro run without pressing ENTER? (Please be gentle - I'm not a VB whiz!!)

I'm using Excel 2003.

First off-I'm probably considered an Excel amateur as my Excel knowledge is only slightly above average. I have a spreadsheet that tracks proposals for the company I work for. At the top of this spreadsheet there are four rows of frozen cells that contain the spreadsheet title and column headers. I currently have a few different macros set up to sort the spreadsheet by the various columns. For example, to sort by the proposal due date you would press ctrl+D, or to sort by the proposal manager you would press ctrl+P. My problem is that this record will be regularly updated and new rows will be inserted and therefore the macros will need to be updated as well. This usually wouldn't be a problem (I think naming the selection area under Insert/Name and then referencing that name in the range of the macro would solve the macro updating problem) however the frozen cells seem to conflict. If I base the macro range on the name of the active worksheet range-I can't seem to get away from the frozen cells not also being selected. Is there a way to automatically update my macros when a row is inserted which will allow me to sort my spreadsheet but keep the frozen cells intact and separate from the range? The only thing that I've found to work so far is setting the macro range for a much larger area than the sheet is filled in (for example the current range is now A4:H48-cells 1-4 are frozen. I set the range to A4:H999 and it seemed to work without affecting the frozen cells). My only problem with this solution is that it's not very stable or permanent. If I leave the department or the company this record will be taken over by someone else who may not necessarily know how to maintain the macros.

If you need more clarification please let me know-any help would be greatly appreciated.

I would like to import data from another workbook, and I have written some code to do so (see below), which runs OK but unfortunately causes subsequent problems (see: lother thread) This is why I'd like to substitute it. For me the difficult part comes with handling the images and avoiding worksheet-naming-collisions

What is the best way to do the following: I'll try some pseudocode here:
For each worksheet in sourcebook do
- import/copy a defined range to a new worksheet in targetworkbook
- import/ copy images (located in a single chart) to the worksheet (NOT chart) in tagetworkbook
- avoid worksheet-naming-collisions: (all sheets always go by the format: "some letter(s), number(s)" or "XXX##") Names in targetbook have priority and may not be changed; freshly imported sheet-names should keep their number but change their letters.

Example: In the targetbook worksheets are called "C5", "C3", "C4"; and in sourcebook they are called "C1", "C2", "C3". After the import the targetbook should hold "C5", "C3", "C4" (unchanged targetbook worksheets) and "D1", "D2", "D3" (modified sourcebook worksheet: here "C" was changed to "D"), while the latter ones hold some imported data (range+images) from their sourcesheets.


	VB:
	
 importOtherSheets() 
     'This macro imports worksheets from other sourceworkbooks.
     
     'VARIABLE-DECLARATION
    Dim wkbSource, wkbTarget As Workbook 
    Dim wksSource, wksTarget, ws, wt, w, finalPosition As Worksheet 
    Dim myrange As Range 
    Dim numCollision, newWorksheetsNum, oldWorksheetsNum, i, j, lowestRow, chartNo As Integer 
    Dim numInsufficient As Integer 
    Dim text, myTag, headerText, defaultInput, changeName, nameNow As String 
    Dim choA As ChartObject 
    Dim shpImChart As Shape 
    Dim sFileName As String 
     
     'no screen repainting: makes macro run faster
    Application.ScreenUpdating = screenUpdatesBegin 
     
     ' set the active sheet as the targetMap
    Set wksTarget = ActiveSheet 
    Set wkbTarget = ActiveWorkbook 
     
     'show message:
    headerText = "Importing experiments: Quick Guide Line" 
    text = "With the next dialog you will choose the source-file you wish " & _ 
    "to import. Please make sure those data are in the right format " & _ 
    "as the import may fail due to any unexpected incoherence in data." & _ 
    "Avoid naming conflicts by using a tag for your source-data. Furthermore " & _ 
    "do NOT import any cell twice, not even under different tags!" & _ 
    "Please note: Importing may take quite a while!" 
    MsgBox text, title:=headerText 
     
     'Show the open dialog and pass the selected file name to the String variable "sFileName"
    sFileName = Application.GetOpenFilename 
    If sFileName = "False" Then Exit Sub 
    Workbooks.Open Filename:=sFileName 
    Set wkbSource = ActiveWorkbook 
    Set wksSource = ActiveSheet 
     
     ' how many new sheets are there
    newWorksheetsNum = wkbSource.Worksheets.Count 
    oldWorksheetsNum = wkbTarget.Worksheets.Count 
     
     'Estimate the amount of naming collisions possible between old target workbook and
     ' the source workbook: very slow, needs to be improved by a list
    numCollision = 0 
    numInsufficient = 0 
     'runnning through all source-sheets
    For i = 1 To newWorksheetsNum 
         'counting insufficient sheets
        If Not sufficientWorksheet(wkbSource.Worksheets(i), minSNRatio, bSNImportFilter) Then 
            numInsufficient = numInsufficient + 1 
        End If 
         'checking for name collisions
        For j = 1 To oldWorksheetsNum 
            If (wkbSource.Worksheets(i).name = wkbTarget.Worksheets(j).name) Then 
                numCollision = numCollision + 1 
                Exit For 
            End If 
        Next j 
    Next i 
     
    If oldWorksheetsNum  1 Then 
         'Second User-input: Which tag shall be added to each name of imported worksheets in order to avoid naming
collisions?
        If (numCollision = 0 And numInsufficient = 0) Then 
            headerText = "Import: Ready for Import!" 
            defaultInput = vbNullString 
        Else 
            headerText = numCollision & " name-collisions! " & numInsufficient & " Insufficient sheets" 
            defaultInput = "00" 
        End If 
        text = "Which tag would you like to add to each name of an imported worksheet?" 
        myTag = Application.InputBox(Prompt:=text, title:=headerText, Default:=defaultInput, Type:=2) 'Type:=2 means
"String-input expected"
    Else 
         'change name of origin-worksheet, so no name-collisions take place
        wksTarget.name = "C" & 9998 
         'set default tag to nothing
        myTag = vbNullString 
    End If 
     
     
     ' FINALLY IMPORTING
    For i = 1 To newWorksheetsNum 
        If sufficientWorksheet(wkbSource.Sheets(i), minSNRatio, bSNImportFilter) Then 
            nameNow = wkbSource.Sheets(i).name 
            If (nameNow  "results" And nameNow  "cc" And nameNow  "hn" And nameNow  "brief") Then 
                 'make a new almost blank sheet
                wkbTarget.Worksheets(wkbTarget.Worksheets.Count).Activate 
                Call addAnotherAlmostBlankSheet 
                Set finalPosition = ActiveSheet 
                 'name source Chart
                wkbSource.Sheets(i).Activate 
                Range("A1").Activate 
                If Sheets(i).ChartObjects.Count > 0 Then 
                    Set choA = Sheets(i).ChartObjects(Sheets(i).ChartObjects.Count) 
                End If 
                 'copy almost everything:
                wkbSource.Sheets(i).Activate 
                Range("A1").Select 
                lowestRow = Cells(65536, 1).End(xlUp).row 'lowest USED data row with values in
                If copyImgAtImport = True Then 
                    wkbSource.Sheets(i).Range("A1:O" + CStr(lowestRow)).Copy Destination:=finalPosition.Range("A1:O" +
CStr(lowestRow)) 
                Else 
                    finalPosition.Range("A1:O" + CStr(lowestRow)) = wkbSource.Sheets(i).Range("A1:O" + CStr(lowestRow)).Value

                    finalPosition.Activate 
                    Call makeUpFormatedSheet(ActiveSheet) 
                End If 
                 
                With finalPosition 
                    .Activate 
                     'check if Cell is active or inactive
                    If .Cells(3, 1).Value = "inactive" Then 
                        Call activateCellSheet(False, showFrapHelp) ' this inactivates the cell (unusual)
                    Else 
                        Call activateCellSheet(True, showFrapHelp) 'this activates the cell (normal)
                    End If 
                    Call updateSheet ' update Sheet
                    .Select 
                    .name = wkbSource.Sheets(i).name & myTag 'rename Sheet
                End With 
            End If 
        End If 
    Next i 
     
     ' close the source-file WITHOUT saving any possible changes
    wkbSource.Close SaveChanges:=False 
     
     ' screen repainting set up again:
    Application.ScreenUpdating = screenUpdatesEnd 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Dear all,

I have encountered a problem. Suppose I have a Excel macro which opens a
data workbook, say "myExcel.xls". When the program runs, within a loops it
copies different range of data from myExcel.xls and generates new excel
workbooks, then copies the selected data to the new workbook. The name of the
newly created workbooks starts from Sheet1, the next one is Sheet2, and so
on.....

However, the program needs to switch between "myExcel.xls" and the new
workbooks during the loop. Here comes the problem, e.g. when the program
activates the new workbook "Sheet1", it does not activate workbook "Sheet1'
actually, it stays at worksheet "Sheet1" of "myExcel.xls" instead. There is a
name conflict of "Sheet1", "Sheet2" and "Sheet3" (myExcel.xls has 3 sheets).
Therefore, how should I avoid this problem??

Can anyone advise?? Thanks a million....

Ivan

hi,

Hi
i'm writing macros for an excel file.

i've a macro which will read the data from there are 30 to 40 work books
each work book contains 8 worksheets and copies that data
and paste the copied data into new workbook with corresponding 8 sheets.

it is copying the data into new work sheet. whats my problem is while coping
the data from all work books data it gives an dailog box.it gives an error
it shows the message as. i used same name in all 30-40 workbooks
_DATA_impact_image

"A formula or sheet you want to move or copy contains the name
'_DATA_impact_image', which already exists on the destination worksheet.Do
you want to use this version of the name?

..TO use name as defined in the destination sheet, click yes.
..To rename the range referred in the formula or worksheet,click no, and
enter a new name in the name Conflict dialog box."

How can i avoid this while gathering the data from the workbooks.

can anyone tell me how to do this.
its very urgent for me

thanx in advance
jaffar

Hey guys,

First off, sorry for tagging onto the end of an old thread last time - most forums I know would sooner you do a search and add to existing threads rather than clog the place with a load of very similar queries. So a misunderstaning on the etiquette of this forum.

Anyhow, I had a load of great help last year consolidating information from a load of files into a central file, most down to Jerry being very patient. Basically the code looks as follows now:

Option Explicit

Sub Consolidate()

'Summary:    Open all Excel files in a specific folder and imports
'            key date into a Summary sheet, one row of data per workbook
Dim fName As String, fPath As String, fpath2 As String, OldDir As String, strsubaddress As String, strname As String

Dim NR As Long
Dim wbData As Workbook, wbkNew As Workbook
Dim ws As Worksheet

    Dim wkb As Workbook
    Dim wkbcount As Integer

    wkbcount = 0

    For Each wkb In Workbooks
        wkbcount = wkbcount + 1
    Next

    If wkbcount > 1 Then
        MsgBox "Please close all other workbooks."
        Exit Sub
    End If


'Setup
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
   
    Set wbkNew = ThisWorkbook
    wbkNew.Activate
    Sheets("Sheet1").Activate   'sheet report is built into, edit to correct sheet name
    If MsgBox("Import new data to this report?", vbYesNo) = vbNo Then Exit Sub
    
    strsubaddress = "'Costs Summary'!A1"
    strname = InputBox(prompt:="SEARCH PARAMETER", Title:="Enter Search Parameter",
Default:="-")
   
    Cells.Clear
    Range("A1:G1").Value = [{"","Description","per L/Kg","5
Litre","4x5L Case","20 Litre","25 Litre"}]
    NR = 2

'Path and filename (edit this section to suit)
    fPath = "D:ArchemAdam mixesLive MixesT1"       'remember final  in this string
    OldDir = CurDir                     'memorizes the users current working path
    ChDir fPath                         'activate the filepath with files to import
    fName = Dir("*" & strname & "*.xls")              'start a listing of desired files, edit the
filter as desired

'Import a sheet from found file
    Do While Len(fName) > 0
        If fName <> wbkNew.Name Then    'make sure this file isn't accidentally reopened
        'Open file
            Set wbData = Workbooks.Open(fName)

        'This is the section to customize, replace with your own action code as needed
            With wbkNew.Sheets("sheet1")
                Dim strTemp As String
                    strTemp = wbData.Name
                
                .Range("A" & NR) = Replace(strTemp, ".xls", "")
                .Hyperlinks.Add anchor:=.Range("A" & NR), Address:=fPath & fName,
subaddress:=strsubaddress
                .Range("B" & NR) = Replace(Sheets("Data list").Range("B2"),
"Production of ", "")
                .Range("C" & NR) = Format(Sheets("Costs Summary").Range("C3"),
"0.00")
                .Range("D" & NR) = Format(Sheets("Costs Summary").Range("C6"),
"0.00")
                .Range("E" & NR) = Format(Sheets("Costs Summary").Range("C5"),
"0.00")
                .Range("F" & NR) = Format(Sheets("Costs Summary").Range("C8"),
"0.00")
                .Range("G" & NR) = Format(Sheets("Costs Summary").Range("C11"),
"0.00")
                .Range("H" & NR) = Sheets("Costs Summary").Range("B14")
                .Range("I" & NR) = Format(Sheets("Costs Summary").Range("C14"),
"0.00")
                .Range("J" & NR) = Sheets("Costs Summary").Range("B17")
                .Range("K" & NR) = Format(Sheets("Costs Summary").Range("C17"),
"0.00")
                .Range("L" & NR) = Sheets("Costs Summary").Range("B20")
                .Range("M" & NR) = Format(Sheets("Costs Summary").Range("C20"),
"0.00")
                
                
            End With
            
        'close file
            wbData.Close False
        'Next row
            NR = NR + 1
        'ready next filename
            fName = Dir
        End If
    Loop

ErrorExit:    'Cleanup
    Range("A1:M1,H1,H:H,J:J,L:L").Select
    Selection.Font.Bold = True
    ActiveSheet.Columns.AutoFit
     
    Range("A2:M200").Select
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=MOD(ROW(),2)=1"
    Selection.FormatConditions(1).Interior.ColorIndex = 34
    
    Range("A1:A200,C1:C200,E1:E200,G1:G200,J1:K200,M1:M200").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A1:M200").Select
    Range("M200").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    Range("A1:M1").Select
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    Application.DisplayAlerts = True         'turn system alerts back on
    Application.EnableEvents = True          'turn other macros back on
    Application.ScreenUpdating = True        'refreshes the screen
    ChDir OldDir                             'restores users original working path

End Sub
The bottom bit, more or less, is ensuring that the whole thing is formatted nicely for the user.

Anyhow, I have been having some issues. There have been a number of times when things go pear shaped when someone accesses one of the hyperlinked files. I hadn't really thought too much of it but it is now a problem. The file that is hyperlinked has a load of its own code. It has open events, it is stuffed with macros... and they are not working properly. If I access the files via explorer then everything works ok. To give you a brief outline, the file opens. It checks to see what else is open and if it conflicts. It then opens a central file (an excel database, if you will) where a whole lot of data and 'common' macros are kept (keeps the file sizes down this way). Anyhow, it appears that, when using the hyperlink, all of these things fail to occur. In fact it appears that any code which is in a sheet of the hyperlinked file (for instance, hide the sheet when it de-activates), fails to run. As a result I get things failing to happen, errors stacking up and a total mess. I can get around it by removing the hyperlink but it IS handy. Do you have any idea what is going on or what might be responsible for the code, quite simply, failing to run when it is supposed to?

Many thanks

Adam

ps. I do have a further query relating to this but it is much less pressing!

I have a userform which allows everyone to add items to a database. Instead of the form directly adding items to a database (because using a shared file proved too much of a hassle considering how many could be using the form at one time vs conflicts), it creates a seperate workbook with a more 'paper like' form that can be printed or emailed to a secretary. We would still like to have this database but would like to make it as easy and efficient as possible for the secretary.

So, I was trying to create a macro that would take the information from the 'paper like' form and transfer it to the database automatically.

Whenever a form is created, the cell ranges are always the same. I don't want the work book named to matter. The worksheet name in the new workbook is custom, based on the requested data.

So, book1 may have a sheet named 'abc 7.22.2011'. cell D5 is name of the person requesting the change. Book2 may have a sheet named 'xyz 7.22.2011'. Cell D5 on that sheet is the name of the person requesting.

I would like to put each request into a workbook titled 'Database', onto a sheet titled 'Database' within the workbook, in the next open row of cells.

I was hoping I could place the macro in the Database workbook and run it from each new book to get the data to transfer right using Activeworkbook, etc.

Does that make sense? Thanks for any help you can offer.

Hello all,

I have some code I have written, when I run it on my machine at home it works no problem, but when i run it on my work machine it fails at a certain point and i get an error saying "Run-Time error ‘91’: Object variable or with block variable not set" The point it fails at is highlighted Red in the code. There is a slight difference between the two versions my home office is version 2002 but the one in the office is 2003. The object library on the home version is 10 the one in the office is 11. But as the one in the office is newer i would have thought there would be no conflicts?

The code is meant to open several files in a directory, open a word document, run some macros on the files and then copy some charts into a word document (That were it fails).

Any way I have included the code below. Can anyone see any problems with it, other than the fact it probably is not all that efficant, i am just wondering why it isn't working (the error is near the end of the code):

Thanks in advance
Mike

Sub BatchFile()
Dim FileList As Variant
Dim MyFileName As String
Dim FileCount As Integer
Dim FileNum As Integer
Dim wdApp As Word.Application
Dim wdDoc As Word.Documents
Dim Wb As Workbook

Set wdApp = CreateObject("Word.Application")
Set wd = wdApp.Documents.Add
wdApp.Visible = False
wdApp.ActiveDocument.SaveAs Filename:="C:ADCPdataADCPdata.doc"
Set wd = wdApp.Documents.Open("C:ADCPdataADCPdata.doc")
wdApp.Visible = True
' wdApp.ActiveDocument.Close
' wdApp.Quit
' Windows("ADCPtest.xls").Activate
ChDir "C:"
FileList = Application.GetOpenFilename(, , , , True)
On Error Resume Next
FileCount = UBound(FileList)
On Error GoTo 0
If Err.Number = 0 Then
For FileNum = 1 To FileCount
MyFileName = FileList(FileNum)

Application.ScreenUpdating = False
Application.EnableEvents = False
Windows("ADCPtest.xls").Activate
Sheets("Raw Data").Select
Cells.Select
Selection.ClearContents
Call ResetRangesAuto
Call ResetTrimDataAuto

Workbooks.OpenText Filename:=MyFileName, Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Cells.Select
Selection.Copy

Windows("ADCPtest.xls").Activate
Sheets("Raw Data").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Call RemoveZerosAuto
Call TrimDataByDepthAuto

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number 0 Then 'Word isn't already running
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0

Application.ScreenUpdating = True

Windows("ADCPtest.xls").Activate
Sheets("Scatter Dir Chart").Select
ActiveChart.ChartArea.Copy
With wdApp.Selection
.PasteAndFormat (wdChartPicture)
Application.CutCopyMode = False
.TypeParagraph
End With

Windows("ADCPtest.xls").Activate
Sheets("Vector Chart").Select
ActiveChart.ChartArea.Copy
With wdApp.Selection
.PasteAndFormat (wdChartPicture)
Application.CutCopyMode = False
.TypeParagraph
End With
Windows("ADCPtest.xls").Activate
For Each Wb In Workbooks
If Wb.Name "ADCPtest.xls" Then
Wb.Close savechanges:=False
End If
Next Wb
Application.StatusBar = "All Workbooks Closed."
Next
End If
Application.EnableEvents = True
End Sub