0

I've written the code below to do a loop witch I have used in the past, I now however want to do switch the loop.

If a cell in column Q contains a 1 then it adds a row with a certain layout. The code now goes from Q3276 to Q8, how do I reverse the process Preferably I want the loop to go rom Q8 to Q LastRow. Also if anyone has a more lean way of writing the code please let me know.

Dim rngc As Range, rc As Long

Set rngc = Range("Q8:Q3276")

For rc = rngc.Count To 1 Step -1
    If rngc(rc).Value = 1 Then
        rngc(rc + 1).EntireRow.Insert
        rngc(rc + 1).EntireRow.Select

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A35").Select

    End If
Next rc
HoekPeter
  • 11
  • 1
  • 1
  • 5

1 Answers1

0

Preferably I want the loop to go rom Q8 to Q LastRow.

To reverse a loop, you can use For rc = 1 to rngc.Count. Note that this will complicate what you are trying to do.

Also if anyone has a more lean way of writing the code please let me know.

  1. Avoid using Select/Selection etc
  2. Use Autofilter. This way no loops will be required and you can work with filtered rows in ONE GO
  3. The border constants range form 5 to 12. What I mean is that the value of xlDiagonalDown is 5 and so on till xlInsideHorizontal which has a value of 12. In such a case we can use a Loop/Select Case to format the borders/cells as shown below

I have commented the code so you should not have a problem understanding it.

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long
    Dim rng As Range
    Dim filteredRange As Range
    Dim i As Long
    
    '~~> Change this to the relevant sheet
    Set ws = Sheet1
        
    With ws
        '~~> Remove any filters
        .AutoFilterMode = False
        
        '~~> Find last row in Col Q
        lRow = .Range("Q" & .Rows.Count).End(xlUp).Row
        
        '~~> Set your range
        Set rng = .Range("Q8:Q" & lRow)
        
        '~~> Filter the range and set your filtered range
        With rng
            .AutoFilter Field:=1, Criteria1:="=1"
            Set filteredRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
        End With
        
        '~~> Check if we have any filtered rows
        If Not filteredRange Is Nothing Then
            With filteredRange
                '~~> Change interior color
                With .Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent1
                    .TintAndShade = 0.599993896298105
                    .PatternTintAndShade = 0
                End With
                
                '~~> Format the borders
                For i = 5 To 12
                    Select Case i
                        '~~> Left, Top, Bottom, Right
                        Case 7 To 10
                            With .Borders(i)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlThin
                            End With
                        '~~> DiagUp,DiagDown,InsideVert,InsideHorz
                        Case 5, 6, 11, 12
                            .Borders(i).LineStyle = xlNone
                    End Select
                Next i
            End With
        End If
        
        '~~> Remove filters
        .AutoFilterMode = False
    End With
End Sub
Nimantha
  • 6,405
  • 6
  • 28
  • 69
Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250