Solved: VB to keep all border

[ashokbioinfo]

VB to keep all border

HI all,
Plz help me.

In column A (Program), I need to fill color (white, background) the entire row where ever I encounter a word "submit" untill last blank row i.e. dynamic range.

After that I have to make entire border from cell(2,2) to last row and column in the dynamic range. (entire border will be from kk in name variable to last m/f in gender)

program name age gender

EP1 kk 23 m
EP2 KK 24 F
EP submit 2 . m/f
RP1 MM 93 m
RP2 NO 74 F
RP submit 2 2 m/f

N.B. EP total. RP total ... etc are single word separated with one space and present in first column(plz dont consider total in name variable)


Advance thanks for your help

[shrivallabha]

Welcome to VBAX. Try this code which seems to work with the sample provided.
[VBA]Option Explicit
Public Sub DoFormatting()
Dim lLastRow As Long, i As Long

Application.ScreenUpdating = False
lLastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lLastRow
If InStr(Range("A" & i).Value, "program") > 0 Then
With Range("A" & i).Resize(, 4)
.Interior.ColorIndex = 48
.BorderAround xlContinuous, xlThin
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
ElseIf InStr(Range("A" & i).Value, "submit") > 0 Then
Range("A" & i).Interior.ColorIndex = 48
With Range("B" & i).Resize(, 3)
.Interior.ColorIndex = 48
.BorderAround xlContinuous, xlThin
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
Else
With Range("B" & i).Resize(, 3)
.BorderAround xlContinuous, xlThin
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
End If
Next i
Application.ScreenUpdating = True
End Sub
[/VBA]

[ashokbioinfo]

thanks a lot Shrivallabha
God bless u

[ashokbioinfo]

Hi Shrivallabha,
the macro is working only for rows. when new columns are added, then it skip to border. can you plz help

[ashokbioinfo]

HI sriballabha,
Any how I have managed. One simple query
whereever in the row fill color work, I want to keep that row font as bold. so in the loop where can I use

Selection.Font.Bold = True

Advance thanks

[shrivallabha]

Hi,

Assuming that 2nd row is header row where we will get to know number of columns give this a try:
[VBA]Option Explicit
Public Sub DoFormatting()
Dim lLastRow As Long, lLastCol As Long, i As Long

Application.ScreenUpdating = False
lLastRow = Range("A" & Rows.Count).End(xlUp).Row
lLastCol = Cells(2, Columns.Count).End(xlToLeft).Column 'Used to determine number of columns
For i = 2 To lLastRow
If InStr(Range("A" & i).Value, "program") > 0 Then
With Range("A" & i).Resize(, lLastCol)
.Font.Bold = True 'Added Here
.Interior.ColorIndex = 48
.BorderAround xlContinuous, xlThin
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
ElseIf InStr(Range("A" & i).Value, "submit") > 0 Then
With Range("A" & i)
.Font.Bold = True 'And Here
.Interior.ColorIndex = 48
With Range("B" & i).Resize(, lLastCol - 1)
.Font.Bold = True 'And here
.Interior.ColorIndex = 48
.BorderAround xlContinuous, xlThin
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
Else
With Range("B" & i).Resize(, lLastCol - 1)
.BorderAround xlContinuous, xlThin
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
End If
Next i
Application.ScreenUpdating = True
End Sub
[/VBA]

[ashokbioinfo]

thanks buddy