Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.
Sub kTest()
Dim i As Long, a(), Addr As String, n As Long, k, r As Range
Set r = Intersect(ActiveSheet.UsedRange, Columns(2))
k = r
For i = UBound(k, 1) To 1 Step -1
If InStr(1, k(i, 1), "-") Then
Addr = Addr & "," & "A" & i & ":A" & i + 4
If Len(Addr) > 240 Then
n = n + 1
ReDim Preserve a(1 To n)
a(n) = Mid$(Addr, 2)
Addr = vbNullString
End If
End If
Next
If Len(Addr) > 1 Then
n = n + 1
ReDim Preserve a(1 To n)
a(n) = Mid$(Addr, 2)
Addr = vbNullString
End If
If n Then
Application.ScreenUpdating = False
With r
For i = 1 To n
.Range(CStr(a(i))).EntireRow.Delete
Next
End With
End If
Application.ScreenUpdating = True
End Sub
sub Hide_Row()
Set rFoundCell = Range("A1")
For lCount = 1 To WorksheetFunction.CountIf(Columns(2), "-")
Set rFoundCells = Columns(2).Find(What:="-", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
Range("B" & rFoundCells.Row & ":B" & rFoundCells.Row+4).Entirerow.hide
Next lCount
End Sub
Sub kTest()
Dim i As Long, a(), Addr As String, n As Long, k, r As Range
Application.ScreenUpdating = False
ActiveSheet.UsedRange.EntireRow.Hidden = False
Set r = Intersect(ActiveSheet.UsedRange, Columns(2))
k = r
For i = UBound(k, 1) To 1 Step -1
If InStr(1, k(i, 1), "-") Then
Addr = Addr & "," & "A" & i & ":A" & i + 4
If Len(Addr) > 240 Then
n = n + 1
ReDim Preserve a(1 To n)
a(n) = Mid$(Addr, 2)
Addr = vbNullString
End If
End If
Next
If Len(Addr) > 1 Then
n = n + 1
ReDim Preserve a(1 To n)
a(n) = Mid$(Addr, 2)
Addr = vbNullString
End If
If n Then
With r
For i = 1 To n
.Range(CStr(a(i))).EntireRow.Hidden = True
Next
End With
End If
Application.ScreenUpdating = True
End Sub
Sub HideRows()
Dim c As Range, i As Long, cnt As Long
With Columns("B:B")
cnt = WorksheetFunction.CountIf(Columns("B:B"), "-")
Set c = .Find("-", LookIn:=xlValues)
For i = 1 To cnt
c.Offset(-3).Resize(4).EntireRow.Hidden = True
Set c = .FindNext(c)
Next i
End With
End Sub
Kyle
Sub HideRows()
Dim c As Range, i As Long, cnt As Long
With Columns("B:B")
cnt = WorksheetFunction.CountIf(Columns("B:B"), "-")
Set c = .Find("-", LookIn:=xlValues)
For i = 1 To cnt
c.Offset(-3).Resize(4).EntireRow.Hidden = True
Set c = .FindNext(c)
Next i
End With
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Application.Dialogs(xlDialogPrint).Show
End Sub
Kyle
If you are experiencing a similar issue, please ask a related question
Join the community of 500,000 technology professionals and ask your questions.