Simplifying VBA code

  • Thread starter Thread starter Guest
  • Start date Start date
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
 
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)
 
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)
 
I tried to fix it myself, but as you can probably tell, I might as well be
trying to read Chinese.
 
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
 
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)
 
Back
Top