Help with multi-formatting of a workbook

[sanoyola]

Hello,

I am trying to wrap my head around macros still. I have used the recorder and have gotten some good results but I am coming to a part where I need some help.

I have a workbook with three spreedsheets. The first spreedsheet has a column range of A-AS. The rows can be anywhere from 4 to 4000. I need a macro to do several steps which I will try to outline by the steps I would need and in the order in which I would need to do them.

1. I would need to delete several columns (A-C, G-H, M-AB, AE-AK)
2. I would need to copy and paste any negative numbers (rows) from column (O) to a new tab called "Credits"
3. I would need to delete any rows that were copied to the "Credits" tab
4. I would then need to custom sort the spreedsheet with three levels- Column C, Column A, Column J
5. I would then need to clear the numerical content of Column (O)- adding a new header as "Quantity"
6. I would then need to add two blank rows between every different product in Column C

I have attached a copy of the raw data so you can see what I am working with, Plus a copy of what I need the spreedsheet to look like after I apply the macro.

Any help would be very much appreciated

[mikeTRON]

Welcome to the Forum.

First, I wouldn't attached two work books, I would attach one workbook with two sheets, so we can see before and after in ONE workbook.
Second, I am having trouble following the before and after as they dont follow what you say you are doing in step 1-6 above.
I think you posted TWO close to or finished products as the BEFORE sample data is NOT form column A to AS as indicated above.

Can you post a more clear example of what you are trying to accomplish with simply names like BEFORE and AFTER for the worksheets?

[mikeTRON]

So far...

Option Explicit

Sub ProcessMyData()

'===================================================================
'Declare Variables
'===================================================================
    Dim wsName As String
    Dim LastRow As Integer
    Dim i As Integer

'===================================================================
'Define Variables
'===================================================================
    wsName = ActiveSheet.Name 'Defines the SheetName
    LastRow = Worksheets(wsName).Cells(Rows.Count, 1).End(xlUp).Row 'This will find the last used row in column A

'===================================================================
'Setup for speed
'===================================================================
    Application.ScreenUpdating = False
    

'===================================================================
'Do Work
'===================================================================

    'Step 1
    'Range("A:C, G:H, M:AB, AE-AK").Delete ' Deletes the columns
    
    'I have no idea what you want for Step 2 as it is unclear - give examples
        'Possibly filter new data on negatives then cut and paste to a sheet CREDITS
            'but does that sheet already exist?
                'Would you need to first CLEAR credits tab, or paste to bottom?
    
    'Step 3
        'Delete all data copied to CREDITs
        
    'Step 4
           'Sort
    ThisWorkbook.Worksheets(wsName).Sort.SortFields.Clear ' clears current sorting
        ThisWorkbook.Worksheets(wsName).Sort.SortFields.Add Key:=Range("C2:C" & LastRow) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        ThisWorkbook.Worksheets(wsName).Sort.SortFields.Add Key:=Range("A2:A" & LastRow) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        ThisWorkbook.Worksheets(wsName).Sort.SortFields.Add Key:=Range("J2:J" & LastRow) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            
                With ThisWorkbook.Worksheets(wsName).Sort
                    .SetRange Range("A1:Q" & LastRow)
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
        
    'Step 5 -Clear Contents in Column O and rename Header
        Range("O:O").ClearContents
            Range("O1").Value = "Quantity"
            
    'Step 6 - Loop through all cells in Column C to Insert Rows
        For i = LastRow To 2 Step -1
            If i <> 2 Then 'Skips Second Row
                If Cells(i, 3).Value <> Cells(i - 1, 3) Then
                    Rows(i & ":" & i + 1).EntireRow.Insert
                        i = i - 3 'skips 3 rows
                End If
            End If
        Next i
            
'===================================================================
'End Macro Procedures
'===================================================================
Application.ScreenUpdating = True

End Sub

[sanoyola]

Hi MikeTRON thank you so much for responding, I in fact did upload an incorrect file. I apologize. I have uploaded a more complete worksheet and took your advice. The book has three sheets, the first sheet is the manipulated raw data, the second is the credits (I would prefer the Macro automatically creates the new tab) and the last tab is how I would like the finish product to look like when all negatives have been removed and the sheet has been re-organized. I hope the new samples will clear up what I am trying to achieve. Again thank you so much for your time. The name of the sheet MDDataExtract is how the file will be named in the end if that helps.

[mikeTRON]

Step 2. I would need to copy and paste any negative numbers (rows) from column (O) to a new tab called "Credits"

Does Credits tab already exist?
Is it Empty?
Do you need to clear it or create it?
Do you need to paste the data to the top as it is fresh data or paste it to the bottom of what is already there?

[sanoyola]

Hi again MikeTRON

The credits tab does not exist- I would like the code to make a new tab called Credits so that it can move the negative rows from column O to it. After all negative rows have been moved over to the newly created credits tab, I would then like the negative rows from the original spreadsheet "MDDataExtract" to be deleted, only leaving the positive numbers.

[mikeTRON]

What does Step 5 mean specifically?

[mikeTRON]

I still have NO idea what step 5 does as it is not clear on your example but here is what I created:

MDDataExtract.xlsm

Option Explicit

Sub ProcessMyData()

'===================================================================
'Declare Variables
'===================================================================
    Dim DataSheet As String 'Used to define DataSource sheet
    Dim CreditsSheet As String 'Used to define Credit sheet
    Dim ws As Worksheet 'Used to create new worksheet
    Dim LastRow As Long 'Used to determine last row with data
    Dim I As Long 'Used to loop through rows

'===================================================================
'Define Variables
'===================================================================
    DataSheet = "MDDataExtract" 'Defines the Data Sheet Name
    CreditsSheet = "Credits" 'Defines the Credits Sheet Name
    LastRow = Worksheets(DataSheet).Cells(Rows.Count, 1).End(xlUp).Row 'This will find the last used row in column A of Data sheet

'===================================================================
'Setup for speed
'===================================================================
    Application.ScreenUpdating = False 'Sets ScreenUpdating Off
    Application.Calculation = xlCalculationManual 'Sets calculations to manual so it wont calc during procedute

'===================================================================
'Process Data
'===================================================================

'Step 1
    ThisWorkbook.Worksheets(DataSheet).Range("A:C, G:H, M:AB, AE:AK").Delete ' Deletes the Columns
    
'Step 2 - Create worksheet then copy paste Negative Order Quantities
    Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) 'Add Worksheet
        ws.Name = CreditsSheet 'Renames Worksheet
    
    'Filter on Negative Column O values
    ThisWorkbook.Worksheets(DataSheet).Range("A:Q").AutoFilter Field:=15, Criteria1:="<0" 'Applies filter on Column 0 for anything less than 0
        ThisWorkbook.Worksheets(DataSheet).Range("A1:Q" & LastRow).SpecialCells(xlCellTypeVisible).Copy
            ThisWorkbook.Worksheets(CreditsSheet).Range("A1").PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'paste visible cells only to Credits tab
                    Application.CutCopyMode = False
            
'Step 3 - Delete Negative Quantities
        ThisWorkbook.Worksheets(DataSheet).Range("A2:Q" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete 'Deletes Copied Data
            ThisWorkbook.Worksheets(DataSheet).Cells.AutoFilter 'Removes Autofilter
            
'Step 4 - Sort
    LastRow = Worksheets(DataSheet).Cells(Rows.Count, 1).End(xlUp).Row 'finds the last used row in column A of Data sheet
    
    ThisWorkbook.Worksheets(DataSheet).Sort.SortFields.Clear ' clears current sorting
        ThisWorkbook.Worksheets(DataSheet).Sort.SortFields.Add Key:=Range("C2:C" & LastRow) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'Sets sort method for column C
        ThisWorkbook.Worksheets(DataSheet).Sort.SortFields.Add Key:=Range("A2:A" & LastRow) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'Sets sort method for column A
        ThisWorkbook.Worksheets(DataSheet).Sort.SortFields.Add Key:=Range("J2:J" & LastRow) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'Sets sort method for column J
            
                With ThisWorkbook.Worksheets(DataSheet).Sort
                    .SetRange Range("A1:Q" & LastRow)
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With 'Applies Sort

'Step 5 -Clear Contents in Column O and rename Header
    'Range("O1").Value = "Quantity"
        'I have no idea what you want for Step 5, it just doesn't make sense
        
'Step 6 - Loop through all cells in Column C to Insert Rows when product name changes
    ThisWorkbook.Worksheets(DataSheet).Activate
        For I = LastRow To 3 Step -1 'Starting at the last cell in column C and going up the worksheet one row at a time
            If Range("C" & I).Value <> Range("C" & I - 1) And Range("C" & I - 1) <> "" Then 'If cell is NOT the same as the cell above it AND cell above is NOT blank then
                Rows(I & ":" & I + 1).EntireRow.Insert 'Inserts 2 rows
            End If
        Next I 'Go to the next row up
    
    ThisWorkbook.Worksheets(DataSheet).Range("A1").Select 'Just selects a random cell to tidy things up at the end
    
'===================================================================
'End Macro Procedures
'===================================================================
    ThisWorkbook.Worksheets("Process").Activate 'Activates this tab, to tidy things up
        Range("A1").Select ' Just to return to a fixed point, why not
    Application.ScreenUpdating = True 'Turns screen updating back on
    Application.Calculation = xlCalculationAutomatic 'Turns calculations back on
    MsgBox "Process Complete" 'Gives the user a message


End Sub

Sub Reset()

Dim ws As Worksheet

'===================================================================
'Setup for speed
'===================================================================
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    
'===================================================================
'Do Work
'===================================================================
    For Each ws In Worksheets
        If UCase(ws.Name) = "CREDITS" Then
            ws.Delete
        End If
    Next ws
    
    'Add code to delete Credits tab?
    Sheets("MDDataExtract - Original").Select
        Cells.Select
            Application.CutCopyMode = False
                Selection.Copy
    Sheets("MDDataExtract").Select
        Range("A1").Select
            ActiveSheet.Paste
                Application.CutCopyMode = False
        Range("A1").Select
        
        If ActiveSheet.AutoFilterMode Then
            Cells.AutoFilter
        End If
        
'===================================================================
'End Macro Procedures
'===================================================================
    ThisWorkbook.Worksheets("Process").Activate
        Range("A1").Select
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True

End Sub