Macros to Sort, Insert rows then copy and paste formulas only form cell ranges to worksheet

NZAS

Board Regular
Joined
Oct 18, 2012
Messages
117
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
I have a spreadsheet I am look for a macros to some thing in this. I am very new to macros and this was originally written by some one else. The macro is below

The Macros is to sort the dispatch worksheet by date Newest to Oldest range A13:L38 after being updated
' it is then to put in a row between each day of the week to seperate these
' It will then copies the formulas in cell range C14:I14 and K14:L14 and paste the formula only to C14:I38 and K14:L38
' so that the formulas in cell C14:I38 And K14:L38 get repopulated into all rows
'
' Active workbooks may use different names these to be updated as names change in the code for workbook.
I would attach a picture to show the final output but do not know how.
Data is populated in a row for each delivery with the date for dispatch
This is copied form spreadsheet Column A and cell 14 is the Day below and column "C" is hidden, Column "L" is the Customer or ship.

Hope this help to give a picture for what I am needing for the final output

Cheers
NZAS
[TABLE="width: 1471"]
<colgroup><col><col><col span="6"><col><col><col></colgroup><tbody>[TR]
[TD="colspan: 3"]Week Commencing :- [/TD]
[TD="colspan: 5"]Monday, 5 August 2019[/TD]
[TD]Version:[/TD]
[TD]1[/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Day[/TD]
[TD]Manifest[/TD]
[TD]Product Type[/TD]
[TD]Tonnes Req[/TD]
[TD]Lots Required[/TD]
[TD]On Truck[/TD]
[TD]Off Site[/TD]
[TD]Lots to Go[/TD]
[TD]Off Site Yard[/TD]
[TD]Colour[/TD]
[TD]Customer or Ship[/TD]
[/TR]
[TR]
[TD]Mon--Aug--05[/TD]
[TD]802082215[/TD]
[TD]178 x 6795[/TD]
[TD]300[/TD]
[TD]123[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]123[/TD]
[TD] [/TD]
[TD]RED[/TD]
[TD]Inex - Ham[/TD]
[/TR]
[TR]
[TD]Mon--Aug--05[/TD]
[TD]802082216[/TD]
[TD]202 x 7000[/TD]
[TD]300[/TD]
[TD]128[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]128[/TD]
[TD] [/TD]
[TD]BLA[/TD]
[TD]Inex - Ham[/TD]
[/TR]
[TR]
[TD]Mon--Aug--05[/TD]
[TD]802082649[/TD]
[TD]202 x 7000[/TD]
[TD]96[/TD]
[TD]41[/TD]
[TD]15[/TD]
[TD]0[/TD]
[TD]26[/TD]
[TD] [/TD]
[TD]GRN / ORA[/TD]
[TD]Altus - Auck[/TD]
[/TR]
[TR]
[TD]Mon--Aug--05[/TD]
[TD]802082319[/TD]
[TD]INGOT x [/TD]
[TD]49[/TD]
[TD]48[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]48[/TD]
[TD] [/TD]
[TD]BLA / TRQ[/TD]
[TD]Navios Summer[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Tue--Aug--06[/TD]
[TD]802082215[/TD]
[TD]178 x 6795[/TD]
[TD]300[/TD]
[TD]123[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]123[/TD]
[TD] [/TD]
[TD]RED[/TD]
[TD]Inex - Ham[/TD]
[/TR]
[TR]
[TD]Tue--Aug--06[/TD]
[TD]802082216[/TD]
[TD]202 x 7000[/TD]
[TD]300[/TD]
[TD]128[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]128[/TD]
[TD] [/TD]
[TD]BLA[/TD]
[TD]Inex - Ham[/TD]
[/TR]
[TR]
[TD]Tue--Aug--06[/TD]
[TD]802082649[/TD]
[TD]202 x 7000[/TD]
[TD]96[/TD]
[TD]41[/TD]
[TD]15[/TD]
[TD]0[/TD]
[TD]26[/TD]
[TD] [/TD]
[TD]GRN / ORA[/TD]
[TD]Altus - Auck[/TD]
[/TR]
[TR]
[TD]Tue--Aug--06[/TD]
[TD]802082325[/TD]
[TD]178 x 5800[/TD]
[TD]116[/TD]
[TD]50[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]50[/TD]
[TD] [/TD]
[TD]RED / PIN[/TD]
[TD]Navios Summer[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Wed--Aug--07[/TD]
[TD]802082215[/TD]
[TD]178 x 6795[/TD]
[TD]300[/TD]
[TD]123[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]123[/TD]
[TD] [/TD]
[TD]RED[/TD]
[TD]Inex - Ham[/TD]
[/TR]
[TR]
[TD]Wed--Aug--07[/TD]
[TD]802082216[/TD]
[TD]202 x 7000[/TD]
[TD]300[/TD]
[TD]128[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]128[/TD]
[TD] [/TD]
[TD]BLA[/TD]
[TD]Inex - Ham[/TD]
[/TR]
[TR]
[TD]Wed--Aug--07[/TD]
[TD]802082649[/TD]
[TD]202 x 7000[/TD]
[TD]96[/TD]
[TD]41[/TD]
[TD]15[/TD]
[TD]0[/TD]
[TD]26[/TD]
[TD] [/TD]
[TD]GRN / ORA[/TD]
[TD]Altus - Auck[/TD]
[/TR]
[TR]
[TD]Wed--Aug--07[/TD]
[TD]802082270[/TD]
[TD]INGOT x [/TD]
[TD]272[/TD]
[TD]264[/TD]
[TD]40[/TD]
[TD]0[/TD]
[TD]224[/TD]
[TD] [/TD]
[TD]BLA[/TD]
[TD]Navios Summer[/TD]
[/TR]
</tbody>[/TABLE]




The macro I did have does not do all that is required as I do not want to have the data to extend past row 38 and only insert the rows to fit no wider than column "L"

Code:
 Range("A14:I38").Select
    ActiveWorkbook.Worksheets("This Week").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("This Week").Sort.SortFields.Add Key:=Range( _
        "A14:A43"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("This Week").Sort
        .SetRange Range("A13:j38")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A14").Select
    With Sheets("This Week")
        .Range("a14").End(xlDown).Select
        While ActiveCell.Row <> 14
            If Day(ActiveCell.Value) = Day(ActiveCell.Offset(-1, 0)) Then
                ActiveCell.Offset(-1, 0).Select
            Else
                ActiveCell.EntireRow.Select
                Selection.Insert Shift:=xlDown
                .Range("e14:J14").Copy
                ActiveCell.Offset(0, 4).PasteSpecial (xlFormulas)
                .Range("44:44").EntireRow.Delete
                ActiveCell.Offset(-1, -4).Select
            End If
        Wend
    End With
End Sub
 
Last edited by a moderator:

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Please provide a few lines of the dispatch worksheet before the code is run, be sure to state what worksheet rows they are in.
What row on that worksheet contains the headers? What is the last possible data row? Is there EVER any blank rows in that data?
Are the values in column A dates that are formatted with the double dashes, or are they text?

Inserting blank rows in the data between the dates can add either 4 lines (for Mon-Fri weeks) or 6 lines for Mon-Sun weeks) is there enough data in the dispatch worksheet that the additional rows will move the bottom row past line 38?

I assume formulas should not be placed in otherwise blank rows.

What sheet contains the formulas?
Be sure to show the formulas location(s)

As I read your description it seems as if formulas and headers are in row 14. Please expand your comments to clear up my confusion.

Replace both of these rows:
ActiveCell.EntireRow.Select
Selection.Insert Shift:=xlDown
with this row:
Range(Cells(ActiveCell.Row, "A"), Cells(ActiveCell.Row, "L")).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
to only insert cells in columns A:L
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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
Back
Top