VBA clearing sheet below header

[pile-it Mark]

i have a code that functions great. after testing i realized i need it to clear contents below row 3.

row 1 is headings, row 2 is formulas, row 3 is a blank buffer, i would like to keep the format, but that could be ignored.

and i would need to tell my code to start posting on line 4

I am very new at VBA. 5 days learning so far. everything i have is copy and paste. with lots of help from this site, Yahoo, and trials. now i cant find the code that i read that discussed this. and doubt i could figure out where to place it if i found it.

Thanks

Option Explicit
Sub Copy1stRow()
' hiker95, 01/15/2014, ME750730 Default Re: copy of a single row from multiple worksheets into summary sheet within the same workbook
 ' modified by pile-it Mark with help from Ashutosh Kumar 01/06/2017
Dim ws As Worksheet, nr As Long
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "2017 TOTALS" _
And Not ws.Name = "distance table" _
And Not ws.Name = "Flight Log 2017 Original" _
And Not ws.Name = "Summary" _
And Not ws.Name = "Master" _
And Not ws.Name = "vba test" Then
nr = Sheets("2017 TOTALS").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
ws.Rows(1).Copy
Sheets("2017 TOTALS").Rows(nr).PasteSpecial Paste:=xlPasteValues
End If
Next ws
End Sub

 

[dmt32]

Hi,
Untested but see if this update to your code does what you want:

Option Explicit
Sub Copy1stRow()
    Dim arr As Variant, m As Variant
    Dim ws As Worksheet, wsTotals As Worksheet
    Dim nr As Long
    
'summary sheet
    Set wsTotals = ThisWorkbook.Worksheets("2017 TOTALS")

'sheets to be excluded
    arr = Array("2017 TOTALS", "distance table", "Flight Log 2017 Original", "Summary", "Master", "vba test")
    
    Application.ScreenUpdating = False
    
'clear contents below row 3
    wsTotals.Range("A4").CurrentRegion.ClearContents
    
    For Each ws In ThisWorkbook.Worksheets
'check ws against exlcuded list
        m = Application.Match(ws.Name, arr, False)
        If IsError(m) Then
            nr = wsTotals.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
'ensure start at row 4
            If nr < 4 Then nr = 4
'copy header row
            ws.Rows(1).Copy
'paste to summary sheet
            wsTotals.Rows(nr).PasteSpecial Paste:=xlPasteValues
'clear clipboard
            Application.CutCopyMode = False
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

Hope Helpful

Dave

 

[pile-it Mark]

Thanks! it seems to work. after i started over with a new test workbook. had to many VBA running on the old one and could not turn them off

could it be written to sort from row 4 down based on column B value? smallest to largest, excluding blank rows?

as i am new at this,how do you determine how to approach a problem like that?

 

[dmt32]

Hi,
glad update helped you.

If you want to add a sort routine just turn the macro recorder on & then do required sort - code can then be edited to clean it up.
If not sure how to do that post it to forum.

Dave.

 

[pile-it Mark]

I will give it a try. Thank you

 

[pile-it Mark]

will changing this line to "4" keep from wiping the header formulas?

'copy header row
ws.Rows(1).Copy

 

[dmt32]

will changing this line to "4" keep from wiping the header formulas?

'copy header row
ws.Rows(1).Copy

That line copies Row 1

this line

If nr < 4 Then nr = 4

should ensure that you start from row 4

 

[pile-it Mark]

found my issue. fixed it still works. thanks and recorded my first Micro! just not sure how to add in into the copy1st row

Sub sortRow4colB()
'
' sortRow4colB Macro
'pile-it Mark 1/10/2017

'
    Rows("4:199").Select
    ActiveWorkbook.Worksheets("2017 TOTALS").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("2017 TOTALS").Sort.SortFields.Add Key:=Range( _
        "B4:B1098"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("2017 TOTALS").Sort
        .SetRange Range("A4:AG1098")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 

[dmt32]

found my issue. fixed it still works. thanks and recorded my first Micro! just not sure how to add in into the copy1st row

Place updated code in your module:

Sub sortRow4colB(ByVal ws As Object, ByVal SortOrder As XlSortOrder)
'
' sortRow4colB Macro
'pile-it Mark 1/10/2017


    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add Key:=ws.Range(ws.Range("B4"), ws.Range("B" & ws.Rows.Count).End(xlUp)), _
    SortOn:=xlSortOnValues, Order:=SortOrder, DataOption:=xlSortNormal
    With ws.Sort
        .SetRange ws.Range("A4").CurrentRegion
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Then place following line of code (shown in bold) in your Copy1strow code ABOVE the line I have shown in RED.

    sortRow4colB wsTotals, xlAscending
    Application.ScreenUpdating = True

The sortRow4colB code has Two Arguments. First is for the worksheet Object. Second gives you the Option to specify Sort Direction.

Not tested but hopefully will do what you want.

Dave

 

[pile-it Mark]

Thank You! that works fantastic!

i have been doing all my work i individual modules. is there a better way? or it it really creators choice?

can other code names be inserted just below the added on as well? i have 3 footer modifications and a PDF export that will all be run at the same time. or would creating a "RunAllCodes" module be a better choice? i played with that a bit and was amazed that it was so easy. but the footer codes are private and do not show up. so how do those get run?

[Code}
Sub RunCopyRowFootPDF()
'
' RunCopyRowFootPDF Macro
'

'
Sheets("2017 TOTALS").Select
Application.Run "'flightlog Master r1.xlsm'!Copy1stRow"
Application.Run "'flightlog 2017r1.xlsm'!CopyRangeFromMultiWorksheets"
Application.Run "'flightlog 2017r1.xlsm'!exportPDF"
End Sub
[/Code]