Copy Template and rename sheet based on list

padadof2

New Member
Joined
Jan 11, 2010
Messages
36
I have a template worksheet named "0MAX2RE" that I need to copy and then rename based on a list. My problem is that the list contains duplicates, which I need to show with the suffix (1), (2), Etc. The list also contains text that could be over 31 characters and have special characters. I am using inputbox for the user to let me know which items they want to copy a new sheet for. Here is what I am working with, and it works, but not always, and not always as intended
VBA Code:
Public Sub CopyOmaxsBidSheets()
    Dim wks As Worksheet
    Dim FindMU As String
    Set wks = Worksheets("Bid Sheet")
    Dim xcell, Xrg, Xrg1, xCOSTrg, xMUrg As Range
    Dim k As Integer
    On Error GoTo ErrorHandler
    Set Xrg = Application.InputBox("Please select the items to create bid sheet for:", "Do It,", , , , , , 8)
    If Xrg Is Nothing Then Exit Sub
    
    For Each xcell In Xrg
        'k = k + 1
        If xcell.Value <> "" Then
            On Error Resume Next
            Sheets("0MAX2RE").Visible = True
            Sheets("0MAX2RE").Copy After:=Worksheets(Sheets.Count)
            ActiveSheet.Name = Left(xcell.Value, 29)
                    With ActiveSheet
                        Set Xrg1 = .Cells.Find(what:="MARK-UP")
                        Set xCOSTrg = Xrg1.Offset(-2, 2)
                        Set xMUrg = Xrg1.Offset(1, 1)
                        wks.Range(xcell.Address, xcell.Address).Offset(0, 4).Value = "='" & ActiveSheet.Name & "'!" & xCOSTrg.Address(RowAbsolute:=False, ColumnAbsolute:=False)
                        wks.Range(xcell.Address, xcell.Address).Offset(0, 5).Value = "='" & ActiveSheet.Name & "'!" & xMUrg.Address(RowAbsolute:=False, ColumnAbsolute:=False)
                    End With
                    If Err.Number = 1004 Then
                    k = k + 1
                        ActiveSheet.Name = Left(xcell.Value, 27) & "(" & k & ")"
                        With ActiveSheet
                            Set Xrg1 = .Cells.Find(what:="MARK-UP")
                            Set xCOSTrg = Xrg1.Offset(-2, 2)
                            Set xMUrg = Xrg1.Offset(1, 1)
                            wks.Range(xcell.Address, xcell.Address).Offset(0, 4).Value = "='" & ActiveSheet.Name & "'!" & xCOSTrg.Address(RowAbsolute:=False, ColumnAbsolute:=False)
                            wks.Range(xcell.Address, xcell.Address).Offset(0, 5).Value = "='" & ActiveSheet.Name & "'!" & xMUrg.Address(RowAbsolute:=False, ColumnAbsolute:=False)
                        End With
                    If Err.Number = 1004 Then
                    k = k + 1
                        ActiveSheet.Name = Left(xcell.Value, 27) & "(" & k & ")"
                            With ActiveSheet
                            Set Xrg1 = .Cells.Find(what:="MARK-UP")
                            Set xCOSTrg = Xrg1.Offset(-2, 2)
                            Set xMUrg = Xrg1.Offset(1, 1)
                            wks.Range(xcell.Address, xcell.Address).Offset(0, 4).Value = "='" & ActiveSheet.Name & "'!" & xCOSTrg.Address(RowAbsolute:=False, ColumnAbsolute:=False)
                            wks.Range(xcell.Address, xcell.Address).Offset(0, 5).Value = "='" & ActiveSheet.Name & "'!" & xMUrg.Address(RowAbsolute:=False, ColumnAbsolute:=False)
                        End With
                    End If
                End If
        End If
    Next
ErrorHandler:
    Sheets("0MAX2RE").Visible = False
End Sub
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

Forum statistics

Threads
1,147,451
Messages
5,741,191
Members
423,647
Latest member
lyanndominique

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top