Simplifying VBA code

G

Guest

I actually have a couple of questions:

I have a workbook with 2 worksheets in it. On worksheet2 is a list of names,
unformatted and raw. The list exists simply to be a list that can be updated,
but has no purpose other than that. On worksheet 1 I have a schedule of
sorts. I have been recording a macro to find and format the names from the
list on worksheet2. Here is the code I have:
Sub proline()
'
' proline Macro
' Macro recorded 11/2/2004 by SGAUER
'

'
Cells.Find(What:="anix", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
With Selection.Interior
.ColorIndex = 43
.Pattern = xlSolid
End With
Selection.Font.Bold = True
Cells.Find(What:="bach", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
With Selection.Interior
.ColorIndex = 43
.Pattern = xlSolid
End With
Selection.Font.Bold = True
Cells.Find(What:="buck", After:=ActiveCell, LookIn:=xlFormulas,
LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
With Selection.Interior
.ColorIndex = 43
.Pattern = xlSolid
End With
Selection.Font.Bold = True
Cells.Find(What:="bwoo", After:=ActiveCell, LookIn:=xlFormulas,
LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
With Selection.Interior
.ColorIndex = 43
.Pattern = xlSolid
End With
Selection.Font.Bold = True
ActiveWindow.ScrollRow = 1
Range("A1").Select
End Sub

How do I simplify it and write a next code so that it will automatically
read from the list and format the names accordingly on worksheet 1?

Thanks for your help,
Steve
 
B

Bob Phillips

Option Explicit

Sub proline()
Dim cRows As Long
Dim i As Long
With Worksheets("Sheet2")
cRows = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To cRows
prolineFind .Cells(i, "A")
Next i
End With
End Sub

Sub prolinFind(val As String)
Dim oRng As rantge

With Worksheets("Sheet1")
On Error Resume Next
Set oRng = .Cells.Find(What:="anix", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not oRng Is Nothing Then
With oRng
With .Interior
.ColorIndex = 43
.Pattern = xlSolid
End With
.Font.Bold = True
End With
End If
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)
 
B

Bob Phillips

Sorry typos, try this

Option Explicit

Sub proline()
Dim cRows As Long
Dim i As Long
With Worksheets("Sheet2")
cRows = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To cRows
prolineFind .Cells(i, "A")
Next i
End With
End Sub

Sub prolineFind(val As String)
Dim oRng As Range

With Worksheets("Sheet1")
On Error Resume Next
Set oRng = .Cells.Find(What:=val, _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not oRng Is Nothing Then
With oRng
With .Interior
.ColorIndex = 43
.Pattern = xlSolid
End With
.Font.Bold = True
End With
End If
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)
 
G

Guest

I tried to fix it myself, but as you can probably tell, I might as well be
trying to read Chinese.
 
G

Guest

Thank you sir. It worked great. I have one more question though. How can i
tweak it so that instead of jus the once cell bg color being edited, the cell
bg color will change for the entire row of information (a:ah)?

Thanks again,
Steve
 
B

Bob Phillips

Option Explicit

Sub proline()
Dim cRows As Long
Dim i As Long
With Worksheets("Sheet2")
cRows = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To cRows
prolineFind .Cells(i, "A")
Next i
End With
End Sub

Sub prolineFind(val As String)
Dim oRng As Range

With Worksheets("Sheet1")
On Error Resume Next
Set oRng = .Cells.Find(What:=val, _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not oRng Is Nothing Then
With oRng.Entirerow
With .Interior
.ColorIndex = 43
.Pattern = xlSolid
End With
.Font.Bold = True
End With
End If
End With

End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top