Implementing same code into a new module

[boomboomblock]

Hi I was given a piece of code and told it would make my program run quicker but I don't really know how to implement my original code into the new piece. I have tried substituting pieces of code into it but I always get an error or the wrong outcome. If anyone could help me out with it I would be very grateful.

ORIGINAL CODE

Sub splitSheets()

    Dim i As Long, a, nome As String, ws As Worksheet

    Application.ScreenUpdating = False

    On Error Resume Next

    For Each ws In ThisWorkbook.Worksheets

        If ws.Name <> "WL1C FINAL REPORT" Then

            ws.Cells.ClearContents

        End If

    Next

        With Sheets("WL1C FINAL REPORT")

             a = .Range("B7:B" & .Cells(.Rows.Count, 2).End(xlUp).Row)

            For i = 1 To UBound(a)

                 If Trim(a(i, 1)) <> vbNullString Then

                     nome = Trim(a(i, 1))

                     If Not Evaluate("ISREF('" & nome & "'!A6)") Then      'A1 to A6

                        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = nome

                     End If

                        .Range("A6:S6").Copy Worksheets(nome).Range("A6")  ' A1 to A6

                        .Cells(i + 6, 2).Resize(, 19).Copy                                '(i, 2) - i = the row to start on and 2 = the number of columns over to start pasting

                        Worksheets(nome).Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteAll

                        Worksheets(nome).EntireRow.AutoFit

                        Worksheets(nome).Columns("F").NumberFormat = "dd-mmm-yy"

                        Worksheets(nome).Columns("I").NumberFormat = "dd-mmm-yy"

                        Worksheets(nome).Columns("J").NumberFormat = "dd-mmm-yy"

                        Worksheets(nome).Columns("L").NumberFormat = "dd-mmm-yy"    'Date formats

                        Worksheets(nome).Columns("M").NumberFormat = "dd-mmm-yy"

                        Worksheets(nome).Columns("O").NumberFormat = "dd-mmm-yy"

                 End If

            Next i

        End With

    Application.CutCopyMode = 0

    Application.ScreenUpdating = True

End Sub

NEW LAYOUT

Sub newSplitSheets()

 Dim a, i As Long, j As Long, NR As Long, LR&, ws As Worksheet

 

    Application.ScreenUpdating = False

    On Error Resume Next

    For Each ws In ThisWorkbook.Worksheets

        If ws.Name <> "WL1C FINAL REPORT" Then

            ws.Cells.ClearContents

        End If

    Next

 

 With Worksheets("WL1C FINAL REPORT")

    a = .Range("B7").CurrentRegion.Value

 End With



 For i = 7 To UBound(a)

    If Not Evaluate("=ISREF(" & a(i, 2) & "!A6)") Then

        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = a(i, 2)

    End If

    With Worksheets(a(i, 2))

        NR = .Cells(Rows.Count, "B").End(xlUp).Row + 1

        For j = 1 To UBound(a, 2)

            .Cells(1, j) = a(6, j)

            .Cells(NR, j) = a(i, j)

        Next

    End With

 Next

End Sub

[tehneXus]

Hi,

1. Remove

On Error Resume Next

from the code, otherwise you will not notice strange behavior

2. Replace

For i = 7 To UBound(a)

with

For i = LBound(a, 1) To UBound(a, 1)

If you still have problems a sample workbook with test data would be helpful

[boomboomblock]

The 'newSplitSheets' code is quite confusing to me anyway and when I put your code in it didn't work. The other code is working surprisingly fast now and I can't understand why, must be a temperamental piece of code! Thanks for the help anyway, always much appreciated

[tehneXus]

If you still have performance problems try my interpretation of splitSheets, if not please mark this thread solved.

Option Explicit

Sub splitSheets()
    Dim i As Long, aData, aHeadings, nome As String, ws As Worksheet
    Application.ScreenUpdating = False

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "WL1C FINAL REPORT" Then
            ws.Cells.ClearContents
        End If
    Next
    With Sheets("WL1C FINAL REPORT")
        aHeadings = .Cells(6, 2).Resize(, 20).Value
        aData = .Range(.Cells(7, 2), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, .Cells(6, .Columns.Count).End(xlToLeft).Column)).Value
    End With
    For i = 1 To UBound(aData, 1)
        nome = Trim(aData(i, 1))
        If nome <> vbNullString Then
            If Not Evaluate("ISREF('" & nome & "'!A6)") Then
                Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = nome
                With Worksheets(nome)
                    Union(.Columns("F"), .Columns("I:J"), .Columns("L:M"), .Columns("O")).NumberFormat = "dd-mmm-yy"
                End With
            End If
            With Worksheets(nome)
                .Cells(6, 2).Resize(, 18).Value = aHeadings
                .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row + 1, 2).Resize(, 18).Value = _
                        Array(aData(i, 1), aData(i, 2), aData(i, 3), aData(i, 4), aData(i, 5), aData(i, 6), aData(i, 7), _
                        aData(i, 8), aData(i, 9), aData(i, 10), aData(i, 11), aData(i, 12), aData(i, 13), aData(i, 14), _
                        aData(i, 15), aData(i, 16), aData(i, 17), aData(i, 18))
                
            End With
        End If
    Next i
    
    Application.ScreenUpdating = True
End Sub