Need help in MS Excel Macro creation

Microsoft Excel 2007
February 15, 2010 at 12:13:32
Specs: Windows XP
Hello,

I need help in creating Macro in MS excel. In Col. Q, I have the category updated and I want the entire rows to be pasted into different sheets as per the category mentioned in Col. Q, point to note here is it should also create different worksheets with the data mentioned in Col. Q. The different categories in Col. Q are "AXNI", "Non-AXNI", "UPSN", "Journal Entries", etc. and than it should create a PIVOT from the sheet generated for AXNI & Non-AXNI worksheet.
Just to give an overview on my data.....following are the various columns of the report.
ACCTMO SRC DIV AMTLOC DEPTNUM MAJ MINOR SMIN PROJ LOCFLD1 LOCFLD4 ENTRY DATE8 SSR VOUCHER NBR ACCID CARRIER TYPE CATEGORY
Any help will really save a lot of time

edited by moderator: Post moved from Windows XP Forum


See More: Need help in MS Excel Macro creation

Report •

#1
February 16, 2010 at 08:00:49
Hi,

You say that you want to create new worksheets based on the names in column Q

Then copy rows, and presumably paste the row into the worksheet with the name in the cell in column Q at the next empty row.

Then you want the macro to create a pivot table.

Can I ask why would you want the macro to create a pivot table.
Creating a pivot table is a one-off activity, and the overhead of writing a macro to do it surely exceeds the work involved in just creating the pivot table.

I can suggest a macro for creating the worksheets and copying the rows.

Option Explicit

Public Sub MoveToTab()
Dim rngStart As Range
Dim rngEnd As Range
Dim rngCell As Range

On Error GoTo ErrHnd

With Worksheets("Source")
    'set start as Q2 i.e., after heading row in column Q
    Set rngStart = .Range("Q2")
    'set end - last used row in column Q
    Set rngEnd = .Range("Q65534").End(xlUp)
    
    'loop through cells in column Q
    For Each rngCell In Range(rngStart, rngEnd)
        'test if tab exists
        On Error Resume Next
        If Not Worksheets(rngCell.Text).Name <> "" Then
            On Error GoTo ErrHnd
            'No worksheet of this name - so create one and copy row
            Worksheets.Add After:=Worksheets(Worksheets.Count)
            Worksheets(Worksheets.Count).Name = rngCell.Text
            rngCell.EntireRow.Copy Destination:=Worksheets(rngCell.Text).Range("A1")
            Else
            On Error GoTo ErrHnd
            'worksheet exists
            'copy row to end of used range
            rngCell.EntireRow.Copy Destination:=Worksheets(rngCell.Text).Range("A1") _
                    .Offset(Worksheets(rngCell.Text).UsedRange.Rows.Count, 0)
        End If
    Next rngCell
End With
Exit Sub

'error handler
ErrHnd:
Err.Clear
End Sub

As this macro calculates the last used row in the source worksheet using .End (xlup) all cells in column Q below the last entry must be empty

The code is written with the source data in a worksheet named 'Source'
Change the code if you are using a different source worksheet name.

There is no test for non-valid worksheet names in the code, so if the macro stops working before copying all rows, look for the first worksheet name that has not been created and check for a non-valid name - mainly names with special characters in such as [ ] / \ : ' *

Regards


Report •
Related Solutions


Ask Question