If Range("H1") = False then...
Dim i as Long
For i = 1 to Rows.Count
If Cells(i, 8).Value = False Then
Cells(i, 8).Font.Color = vbRed
End If
Next i
would loop through all the values in column H whose values are False and set the font color to red.
Dim LastRow As Long
LastRow = xlsht.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For x = 3 To LastRow
Select Case True
Case xlsht.Cells(x, "h") = True
GoTo alreadygood
Case xlsht.Cells(x, "b") = ""
GoTo alreadygood
Case IsNumeric(Left(xlsht.Cells(x, "b"), 5)) = False
GoTo alreadygood
Case IsDate(xlsht.Cells(x, "f")) = True ' already returned
GoTo alreadygood
Case Else
'code that processes the 100 or so rows that need it
End Select
alreadygood:
Next x
Dim LastRow As Long
LastRow = xlsht.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For x = 3 To LastRow
Select Case True
Case xlsht.Cells(x, "h") = False
'code that processes the 100 or so rows that need it
Case xlsht.Cells(x, "h") = True
GoTo alreadygood
Case xlsht.Cells(x, "b") = ""
GoTo alreadygood
Case IsNumeric(Left(xlsht.Cells(x, "b"), 5)) = False
GoTo alreadygood
Case IsDate(xlsht.Cells(x, "f")) = True ' already returned
GoTo alreadygood
Case Else
'code that processes the 100 or so rows that need it
End Select
alreadygood:
Next x
Dim Rng As Range, Cell As Range
Dim LastRow As Long
LastRow = xlsht.UsedRange.SpecialCells(xlCellTypeLastCell).Row
'H2 in the following line assumes that Row2 is header row
With Range("H2:H" & LastRow)
.AutoFilter field:=1, Criteria1:=False
On Error Resume Next
Set Rng = Range("H3:H" & LastRow).SpecialCells(xlCellTypeVisible)
If Not Rng Is Nothing Then
For Each Cell In Rng
'Do whatever you like to do with the False Cells here
Next Cell
End If
.AutoFilter
End With
Dim Rng As Range, Cell As Range
Dim LastRow As Long
Set xlsht = ActiveSheet
LastRow = xlsht.UsedRange.SpecialCells(xlCellTypeLastCell).Row
'H2 in the following line assumes that Row2 is header row
With Range("H2:H" & LastRow)
.AutoFilter field:=1, Criteria1:=False
On Error Resume Next
Set Rng = Range("H3:H" & LastRow).SpecialCells(xlCellTypeVisible)
If Not Rng Is Nothing Then
Rng.Offset(0, 1).Value = "Good"
End If
.AutoFilter
End With
End Sub
Sub YourCode()
'Variable declaration
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = True
End With
'your code goes here
'
'
'
'
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Sub ArrayTechnique()
Dim xlsht As Worksheet
Dim Rng As Range, Cell As Range
Dim LastRow As Long, i As Long
Dim x, y()
Dim TimeTaken As Date
TimeTaken = Now
Set xlsht = ActiveSheet
LastRow = xlsht.UsedRange.SpecialCells(xlCellTypeLastCell).Row
x = xlsht.Range("H3:I" & LastRow).Value
ReDim y(1 To LastRow, 1 To 1)
For i = 1 To UBound(x, 1)
If x(i, 1) = False Then
y(i, 1) = "Good" 'Getting new value for col. I
Else
y(i, 1) = x(i, 2) 'retaining the old value of col. I
End If
Next i
Range("I3").Resize(UBound(y)).Value = y
MsgBox "Time taken : " & Format(Now - TimeTaken, "hh:mm:ss")
End Sub
Dim xlsht As Worksheet
Dim Rng As Range, myCell As Range
Dim LastRow As Long, i As Long
Dim x, y()
Dim TimeTaken As Date
TimeTaken = Now
Set xlsht = ActiveSheet
LastRow = xlsht.UsedRange.SpecialCells(xlCellTypeLastCell).Row
x = xlsht.Range("H2:I" & LastRow).Value
ReDim y(1 To LastRow, 1 To 1)
For i = 1 To UBound(x, 1)
If x(i, 1) = False Then
y(i, 1) = "Good" 'Getting new value for col. I
Else
y(i, 1) = x(i, 2) 'retaining the old value of col. I
End If
Next i
xlsht.Range("I2:I" & LastRow).Value = y
MsgBox "Time taken : " & Format(Now - TimeTaken, "hh:mm:ss")
If you are experiencing a similar issue, please ask a related question
Title | # Comments | Views | Activity |
---|---|---|---|
Excel VBA get Access table names with ADO | 2 | 21 | |
Select Next Route by Time | 4 | 20 | |
Excel VBA Select non contiguous cells in a loop | 4 | 32 | |
Want to Compare Ratings by group of tier's stuck in the process | 1 | 17 |
Join the community of 500,000 technology professionals and ask your questions.