looking across a row for certain data

  • Thread starter Thread starter thomas donino
  • Start date Start date
T

thomas donino

I am trying to locate certain text in a cell and if found I want to look at
each cell to its right, one at a time and if the number in the cell is
greater than 75 bold it and background color it yellow. I am having trouble
with 1. How to determine that the string is found and in what cell and 2. how
to set up the loop to look across the row.

ranPerfInfoEndCell.Column is the last column in that range


'get the last cell in the Performance output range
Col = ranPerfInfoStartCell.Column
Rw = Sheet1.Cells((ranPerfInfoStartCell.Row), (Col)).End(xlDown).Row
Col = Sheet1.Cells([Rw], 50).End(xlToLeft).Column
Set ranPerfInfoEndCell = Sheet1.Cells([Rw], [Col])
Set ranPerfInfo = Sheet1.Range(ranPerfInfoStartCell, ranPerfInfoEndCell)
Set varFound = ranPerfInfo.Find("PctPos")
If Not varFound Is Nothing Then
Exit Sub
Else
For i =
 
Hi Thomas

This should get you on your way. The following finds the word "Test"
- change this to appropriate. It assumes when the cell is found that
you have data to the right. Anyways post if you need further
assistance.


Take care

Marcus

Option Explicit
Option Compare Text
Sub FindOver75()
'Finds Test, then uses that cell as reference point of over 75
identification.
Dim i As Integer
Dim Cfnd As Integer
Dim Rfnd As Integer
Dim endCol As Integer
Dim MyFnd As String

MyFnd = "Test" ' Change here
Rfnd = Cells.Find(What:=MyFnd).Row
Cfnd = Cells.Find(What:=MyFnd).Column + 1
endCol = Cells(Rfnd, Cfnd).End(xlToRight).Column

For i = Cfnd To endCol
If Cells(Rfnd, i).Value > 75 Then
Cells(Rfnd, i).Interior.Color = vbYellow
Cells(Rfnd, i).Font.Bold = True
End If
Next

End Sub
 
With VBA, I would use FIND to find the cell.row and then the last column in
that row and then loop each to color it

Sub findtextandcolorcellsinrowif()
what = "aaa"
Set mr = Cells.Find(what, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not mr Is Nothing Then
lc = Cells(mr.Row, Columns.Count).End(xlToLeft).Column
For Each c In Cells(mr.Row, mr.Column).Resize(, lc - mr.Column + 1)
If IsNumeric(c) And c > 70 Then
c.Interior.ColorIndex = 36
c.font=bold=true
end if
Next c
End If
End Sub
 
I solved it on my own but thank you for the help. I did so in this manner


ranTargRow = varRange.Row
For i = ranPerfInfoStartCell.Column + 1 To Col
With Cells([ranTargRow], )
If .Value > 75.01 Then
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 52479
.TintAndShade = 0
.PatternTintAndShade = 0
End With ' .Interior
.Font.Bold = True
End If
End With
Next i

Can I formatted the cell directly 2 rows above this one the same way within
this loop?
 
Hi Thomas

Fantastic that you worked this out all by yourself. That being the
case you really should have been able to solve your follow up question
no problem at all.
Two extra lines cover off your request -see below.

Cheers

Marcus


Sub FindOver75()
'Finds Test, then uses that cell as reference point of over 75

Dim i As Integer
Dim Cfnd As Integer
Dim Rfnd As Integer
Dim endCol As Integer
Dim MyFnd As String

MyFnd = "Test" ' Change here
Rfnd = Cells.Find(What:=MyFnd).Row
Cfnd = Cells.Find(What:=MyFnd).Column + 1
endCol = Cells(Rfnd, Cfnd).End(xlToRight).Column

For i = Cfnd To endCol
If Cells(Rfnd, i).Value > 75.01 Then
Cells(Rfnd, i).Interior.Color = vbYellow
Cells(Rfnd, i).Font.Bold = True
Cells(Rfnd - 2, i).Interior.Color = vbYellow
Cells(Rfnd - 2, i).Font.Bold = True
End If
Next

End Sub
 
Marcus,

I had tried that with the following code, which looks nearly identical to
how you had it but it barfs on the first line with Cells([rantargRow
-2],).......
and yet yours works perfectly and is syntatically almost identical

For i = ranPerfInfoStartCell.Column + 1 To Col

If Cells([ranTargRow], ).Value > 75.01 Then
Cells([ranTargRow], ).Interior.Pattern = xlSolid
Cells([ranTargRow], ).Interior.PatternColorIndex =
xlAutomatic
Cells([ranTargRow], ).Interior.Color = 52479
Cells([ranTargRow], ).Font.Bold = True
Cells([ranTargRow -2], ).Interior.Pattern = xlSolid
Cells([ranTargRow -2], ).Interior.PatternColorIndex
= xlAutomatic
Cells([ranTargRow -2], ).Interior.Color = 52479
Cells([ranTargRow -2], ).Font.Bold = True
End If
Next i
 
Not sure why this is doing this but I made this whole section another
subroutine and Im calling it from the major routine and it works that way.
Thanks for the help

thomas donino said:
Marcus,

I had tried that with the following code, which looks nearly identical to
how you had it but it barfs on the first line with Cells([rantargRow
-2],).......
and yet yours works perfectly and is syntatically almost identical

For i = ranPerfInfoStartCell.Column + 1 To Col

If Cells([ranTargRow], ).Value > 75.01 Then
Cells([ranTargRow], ).Interior.Pattern = xlSolid
Cells([ranTargRow], ).Interior.PatternColorIndex =
xlAutomatic
Cells([ranTargRow], ).Interior.Color = 52479
Cells([ranTargRow], ).Font.Bold = True
Cells([ranTargRow -2], ).Interior.Pattern = xlSolid
Cells([ranTargRow -2], ).Interior.PatternColorIndex
= xlAutomatic
Cells([ranTargRow -2], ).Interior.Color = 52479
Cells([ranTargRow -2], ).Font.Bold = True
End If
Next i




marcus said:
Hi Thomas

Fantastic that you worked this out all by yourself. That being the
case you really should have been able to solve your follow up question
no problem at all.
Two extra lines cover off your request -see below.

Cheers

Marcus


Sub FindOver75()
'Finds Test, then uses that cell as reference point of over 75

Dim i As Integer
Dim Cfnd As Integer
Dim Rfnd As Integer
Dim endCol As Integer
Dim MyFnd As String

MyFnd = "Test" ' Change here
Rfnd = Cells.Find(What:=MyFnd).Row
Cfnd = Cells.Find(What:=MyFnd).Column + 1
endCol = Cells(Rfnd, Cfnd).End(xlToRight).Column

For i = Cfnd To endCol
If Cells(Rfnd, i).Value > 75.01 Then
Cells(Rfnd, i).Interior.Color = vbYellow
Cells(Rfnd, i).Font.Bold = True
Cells(Rfnd - 2, i).Interior.Color = vbYellow
Cells(Rfnd - 2, i).Font.Bold = True
End If
Next

End Sub
Click to expand...
Click to expand...
 
Did you test mine?
--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
thomas donino said:
Not sure why this is doing this but I made this whole section another
subroutine and Im calling it from the major routine and it works that way.
Thanks for the help

thomas donino said:
Marcus,

I had tried that with the following code, which looks nearly identical to
how you had it but it barfs on the first line with Cells([rantargRow
-2],).......
and yet yours works perfectly and is syntatically almost identical

For i = ranPerfInfoStartCell.Column + 1 To Col

If Cells([ranTargRow], ).Value > 75.01 Then
Cells([ranTargRow], ).Interior.Pattern = xlSolid
Cells([ranTargRow], ).Interior.PatternColorIndex
=
xlAutomatic
Cells([ranTargRow], ).Interior.Color = 52479
Cells([ranTargRow], ).Font.Bold = True
Cells([ranTargRow -2], ).Interior.Pattern =
xlSolid
Cells([ranTargRow -2],
).Interior.PatternColorIndex
= xlAutomatic
Cells([ranTargRow -2], ).Interior.Color = 52479
Cells([ranTargRow -2], ).Font.Bold = True
End If
Next i




marcus said:
Hi Thomas

Fantastic that you worked this out all by yourself. That being the
case you really should have been able to solve your follow up question
no problem at all.
Two extra lines cover off your request -see below.

Cheers

Marcus


Sub FindOver75()
'Finds Test, then uses that cell as reference point of over 75

Dim i As Integer
Dim Cfnd As Integer
Dim Rfnd As Integer
Dim endCol As Integer
Dim MyFnd As String

MyFnd = "Test" ' Change here
Rfnd = Cells.Find(What:=MyFnd).Row
Cfnd = Cells.Find(What:=MyFnd).Column + 1
endCol = Cells(Rfnd, Cfnd).End(xlToRight).Column

For i = Cfnd To endCol
If Cells(Rfnd, i).Value > 75.01 Then
Cells(Rfnd, i).Interior.Color = vbYellow
Cells(Rfnd, i).Font.Bold = True
Cells(Rfnd - 2, i).Interior.Color = vbYellow
Cells(Rfnd - 2, i).Font.Bold = True
End If
Next

End Sub
Click to expand...
Click to expand...
Click to expand...
 
Back
Top