ActiveSheet.UsedRange.Select with conditions

[2Took]

Need Macro to copy specific range on a sheet. It will always be in columns C thru H, but how far down varies and macro needs to determine that. Start row no less than 3, but needs to adjust that lower, based on cell value in column H starting to be greater than zero, i.e. H3, H4 may be zero one time, but H3:H6 may be zero another, macro needs to exclude those rows from copying.

So far I only got:

ActiveSheet.UsedRange.Select

 

[HaHoBe]

Hi,

can you use the Autofilter for excluding rows? If not maybe start with something like

Sub s1611512()
Dim lngStart As Long
Dim lngLast As Long
Dim lngLooper As Long
Dim lngHelp As Long

lngStart = 3
Do While Cells(lngStart, "H").Value <= 0
  lngStart = lngStart + 1
Loop

For lngLooper = 3 To 8
  lngHelp = Cells(Rows.Count, lngLooper).End(xlUp).Row
  If lngHelp > lngLast Then lngLast = lngHelp
Next lngLooper

Range("C" & lngStart & ":H" & lngLast).Select
End Sub

Ciao,
Holger

 

[2Took]

Hi,

can you use the Autofilter for excluding rows? If not maybe start with something like

Sub s1611512()
Dim lngStart As Long
Dim lngLast As Long
Dim lngLooper As Long
Dim lngHelp As Long

lngStart = 3
Do While Cells(lngStart, "H").Value <= 0
  lngStart = lngStart + 1
Loop

For lngLooper = 3 To 8
  lngHelp = Cells(Rows.Count, lngLooper).End(xlUp).Row
  If lngHelp > lngLast Then lngLast = lngHelp
Next lngLooper

Range("C" & lngStart & ":H" & lngLast).Select
End Sub

Ciao,
Holger

Thanks, @HaHoBe

How do you eXclude line(s) from copying if value in H is zero not at the top, but at the bottom?

In other words, idea is to eXclude any lines from copying that have a zero in H column.

 

[HaHoBe]

Hi 2Took,

any lines without zero either calls for the AutoFilter, the Advanced Filter or VBA Code to loop.

Example for a loop may look like this:

Sub MrE161221A()
'https://www.mrexcel.com/board/threads/activesheet-usedrange-select-with-conditions.1218319/
'mod from https://www.mrexcel.com/board/threads/activesheet-usedrange-select-with-conditions.1218319/post-5956497
Dim lngLast       As Long
Dim lngLooper     As Long
Dim lngHelp       As Long
Dim lngResize     As Long
Dim rngSelect     As Range

Const cstrCheckCol As String = "H"
Const cstrStartCol As String = "C"

With Sheets("Source")
  lngResize = .Cells(1, cstrCheckCol).Column - .Cells(1, cstrStartCol).Column + 1
  
  For lngLooper = 3 To 8
    lngHelp = .Cells(Rows.Count, lngLooper).End(xlUp).Row
    If lngHelp > lngLast Then lngLast = lngHelp
  Next lngLooper
  
  For lngLooper = 3 To lngLast
    If .Cells(lngLooper, cstrCheckCol).Value > 0 Then
      If rngSelect Is Nothing Then
        Set rngSelect = .Cells(lngLooper, cstrStartCol).Resize(, lngResize)
      Else
        Set rngSelect = Union(rngSelect, .Cells(lngLooper, cstrStartCol).Resize(, lngResize))
      End If
    End If
  Next lngLooper
End With

If Not rngSelect Is Nothing Then
  rngSelect.Copy Sheets("Dest").Range("A1")
  Set rngSelect = Nothing
End If

End Sub

Code for Autofilter may look like this (please mind that CurrentRegion will take the whole surrounding area of the starting cell until an empty column or row is detected, this will include rows above as well):

Sub MrE1612219_Autofilter()
'Dest will show the header row as well
With Sheets("Source").Range("C2").CurrentRegion
  .AutoFilter Field:=6, Criteria1:=">0", Operator:=xlFilterValues
  .SpecialCells(xlCellTypeVisible).Copy Sheets("Dest").Range("A1")
  .AutoFilter
End With
End Sub

In both samples data is located on Worksheet("Source"), the found range will be copied over to Worksheet("Dest"). Please adjust the names to suit.

Ciao,
Holger