Insert all the sheets from a double click

[PRADEEPB270]

I have a macro enabled file.

In this file,when I double click on the cell ( e.g.I7) in column 'I' then a sheet insert with all the columns and rows with having codes in column 'I'.

For testing,please double click on cell no. I35,a sheet will be insert and all the datas above mention.

Now,my requirement is when,I double click at once only in column 'I' on any code e.g.cell no.I48,then all the sheets will insert with some extra features as I have shown an example in my attach file.And also i want to retain my existing VBA Codes.If betterment in these codes,welcome.

For more clarification,please refer my attach file and sheet name 'FNSADRSSC' and 'CNDKDRKCC'.

Is it possible through VBA Codes?

[HansV]

Try this code in the worksheet module of the BOM sheet:

Code: Select all

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Row >= 5 And Target.Column = 9 And Target <> "" And Target <> "Code" Then
        If Not Evaluate("ISREF('" & Target & "'!A5)") Then
            Target.CurrentRegion.Copy
            With Worksheets.Add(After:=Worksheets(Worksheets.Count))
                .Name = Target
                .Range("A5").PasteSpecial xlPasteValues
                .Range("A6").ClearContents
                With .Range("B5:H6").Font
                    .Bold = True
                    .Color = vbRed
                End With
                .Range("B:H").EntireColumn.AutoFit
                .Range("A1").Select
            End With
            Cancel = True
            Application.CutCopyMode = False
        End If
    End If
End Sub

[PRADEEPB270]

Codes are not working as desired.
The problems are:-
1-When double click on cell in column 'I' then only one sheet insert .
All sheets should be insert at once double click having codes-'FNSADRSSC','CNDKDRKCC','CNDKDRKSC' etc.
2-Row No.5, font colour is 'Red' in all insert sheet instead of 'Black'.
3-Row no.7,neither 'Bold' nor 'Red' colour.It should be as row no.6 ( Bold with red font colour.)
4-Automatic insert a row ,after blank row when the last code ends up in column 'I' e.g. insert a row no.17 after row no.16 with text as cell no.C17,D17,E17,F17,G17,H17 and I17.

Please look into the matter and if possible attach a sheet for better understanding.

[HansV]

If you want to create sheets for all codes at once, there doesn't seem to be any point in doing this in the double-click event of column I.
You might as well use an ordinary macro in a standard module:

Code: Select all

Sub CreateSheets()
    Dim wshS As Worksheet
    Dim rngS As Range
    Dim rngF As Range
    Dim strAddress As String
    Dim strName As String
    Dim wshT As Worksheet
    Application.ScreenUpdating = False
    Set wshS = Worksheets("BOM")
    Set rngS = wshS.Range("B:B")
    Set rngF = rngS.Find(What:="*")
    strAddress = rngF.Address
    Do
        strName = rngF.Value
        Set wshT = Nothing
        On Error Resume Next
        Set wshT = Worksheets(strName)
        On Error GoTo 0
        If wshT Is Nothing Then
            Set wshT = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            wshT.Name = strName
        Else
            wshT.Cells.Clear
        End If
        rngF.CurrentRegion.Copy
        wshT.Range("A5").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        wshT.Range("A6").ClearContents
        wshT.Range("B5:H7").Font.Bold = True
        wshT.Range("B5:H5").HorizontalAlignment = xlCenter
        wshT.Range("B6:H7").Font.Color = vbRed
        wshT.Range("B:H").EntireColumn.AutoFit
        Set rngF = rngS.FindNext(After:=rngF)
    Loop Until rngF.Address = strAddress
    wshS.Select
    Application.ScreenUpdating = True
End Sub

If you really want to do this from the double-click event of column I, you can call CreateSheets:

Code: Select all

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 9 Then
        Call CreateSheets
    End If
End Sub

See the attached version:

1234.xlsm

[PRADEEPB270]

Well done Hansv.You are really an excel GOD.Very.......Glad to find your awesome working.It will save around my 70 minutes workings.Thanks for your sharing and providing the best result as I want.

[HansV]

I forgot one thing (I'm human after all...): if you double-click in column I, set Cancel = True so that you don't enter edit mode:

Code: Select all

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 9 Then
        Call CreateSheets
        Cancel = True
    End If
End Sub

[Rudi]

I forgot one thing (I'm human after all...)

...but in the other thread you confession to being Poseidon...