PDA

View Full Version : Solved: Macro for Custom Formatting



rrtts
12-21-2006, 12:38 PM
I'm trying to create a macro that will custom format cells that contain a keyword and leave any blank cells or cells with a value different than the keyword unchanged.

The data is always in column A with a range of A5 to A78. The keywords will be in various rows - there will be nearly 30 rows in all that contain the keyword.

The custom format I am trying to achieve is:

Select a group of cells, merge, bold, left/top justification and put a border around it. (I've attached a sample file.)

I've searched the help file and through the the forums...I've been able to modify the below code (from the VBE help file) to find all of my keywords and I've been able to record a macro that gives me the code for the custom format, but I'm having a hard time figuring out how to tie the two together.


With Worksheets(1).Range("a1:a500")
Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Value = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

Any help would be greatly appreciated.

CBrine
12-21-2006, 12:49 PM
This posting error is driving me nuts. Seems like everytime I press the space bar, I'm posting???? Not sure why. Looks like the post button still have focus when I hit the space it posts for some reason.

CBrine
12-21-2006, 12:49 PM
No post

JimmyTheHand
12-21-2006, 12:58 PM
My guess is:

Sub CustomFormat(Cell As Range)
With Cell.Resize(2, 4)
.Merge
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.MergeCells = True
.Font.FontStyle = "Bold"
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub

This was the formatting part. From the procedure that finds the cells with keywords call this formatting subroutine, and feed it the found cell, as a parameter. Like:
With Worksheets(1).Range("a1:a500")
Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
CustomFormat(c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

Zack Barresse
12-21-2006, 02:18 PM
Ugh, why merge? It will play hell to deal with later on, especially in code.

rrtts
12-22-2006, 09:53 PM
@Jimmy The Hand - great! With a little tinkering...it does exactly what I needed it to.

@firefyter - I know what you're saying...but this particular sheet is a form that gets printed...and I have a string of text that I need to wrap into the two rows (merged to one) so it "looks" right when printed.