question

RajeevRaghavan avatar image
0 Votes"
RajeevRaghavan asked BobLarson-6601 answered

Please help me to shorten this code with loop.

valuea = Range("V6")
Last = Cells(Rows.Count, 2).End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, 2).Value) = Range("T6") Then
Cells(i, "A").EntireRow.Resize(valuea, 11).Select
Selection.Interior.ColorIndex = 0
End If
Next i
Selection.Activate
Selection.Interior.ColorIndex = 15

valueb = Range("V7")
Last = Cells(Rows.Count, 2).End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, 2).Value) = Range("T7") Then
Cells(i, "A").EntireRow.Resize(valueb, 11).Select
Selection.Interior.ColorIndex = 0
End If
Next i
Selection.Activate
Selection.Interior.ColorIndex = 15

valuec = Range("V8")
Last = Cells(Rows.Count, 2).End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, 2).Value) = Range("T8") Then
Cells(i, "A").EntireRow.Resize(valuec, 11).Select
Selection.Interior.ColorIndex = 0
End If
Next i
Selection.Activate
Selection.Interior.ColorIndex = 15


121633-vba.jpg


office-vba-devoffice-excel-itpro
vba.jpg (75.8 KiB)
5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

Viorel-1 avatar image
0 Votes"
Viorel-1 answered Viorel-1 edited

Try something like this:

 MySub("V6", "T6")
 MySub("V7", "T7")
 MySub("V8", "T8")

where MySub is:

 Sub MySub(ByVal c1 As String, ByVal c2 as String)
     Dim value, Last, i
     value = Range(c1)
     Last = Cells(Rows.Count, 2).End(xlUp).Row
     For i = Last To 1 Step -1
         If (Cells(i, 2).Value) = Range(c2) Then
             Cells(i, "A").EntireRow.Resize(value, 11).Select
             Selection.Interior.ColorIndex = 0
         End If
     Next i
     Selection.Activate
     Selection.Interior.ColorIndex = 15
 End Sub

The above series of three calls can be replaced with a loop.

5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

BobLarson-6601 avatar image
0 Votes"
BobLarson-6601 answered

Or just

     Sub grey()
        
     Last = Cells(Rows.Count, 2).End(xlUp).Row
     For i = Last To 1 Step -1
        
     If Cells(i, 2).Value = (Range("T6").Value _
     Or Cells(1, 2).Value = Range("T7").Value _
     Or Cells(1, 2).Value = Range("T8").Value) Then
        
     Cells(i, "A").EntireRow.Resize(Range("V6").Value, 11).Select
     Selection.Interior.ColorIndex = 0
        
     End If
     Next i
        
     Selection.Interior.ColorIndex = 15
        
        
     End Sub


5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.