VBA clearing sheet below header

pile-it Mark

Board Regular
Joined
Jan 10, 2006
Messages
125
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


Code:
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
 

Some videos you may like

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,388
Office Version
  1. 2019
Platform
  1. Windows
Hi,
Untested but see if this update to your code does what you want:


Code:
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
 
Last edited:

pile-it Mark

Board Regular
Joined
Jan 10, 2006
Messages
125
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

Well-known Member
Joined
Jul 3, 2012
Messages
6,388
Office Version
  1. 2019
Platform
  1. Windows
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

Board Regular
Joined
Jan 10, 2006
Messages
125

ADVERTISEMENT

I will give it a try. Thank you
 

pile-it Mark

Board Regular
Joined
Jan 10, 2006
Messages
125
will changing this line to "4" keep from wiping the header formulas?

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

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,388
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

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

Code:
If nr < 4 Then nr = 4


should ensure that you start from row 4
 
Last edited:

pile-it Mark

Board Regular
Joined
Jan 10, 2006
Messages
125
found my issue. fixed it still works. thanks and recorded my first Micro! just not sure how to add in into the copy1st row

Code:
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

Well-known Member
Joined
Jul 3, 2012
Messages
6,388
Office Version
  1. 2019
Platform
  1. Windows
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:

Rich (BB code):
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.

Rich (BB code):
    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

Board Regular
Joined
Jan 10, 2006
Messages
125
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]
 

Watch MrExcel Video

Forum statistics

Threads
1,123,270
Messages
5,600,638
Members
414,398
Latest member
dhune

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
Top