PDA

View Full Version : Insert Two Blank Row if Condition Met



malleshg24
07-04-2019, 12:46 PM
Hi Team


Need your help in below Situaton.


In Column B check for each cell , if cell value contain (Rohit,Virat,Dhoni) then
top of that cell Two Blank Row needs to be inserted


and Immediate blank row of top of Cell it should be given Thin Border line,


I have attached workbook which contain Input and Output File,
I want Output in Inputs files range only,


Thanks in advance for your valueable time and help.


Regards,
mg.

p45cal
07-04-2019, 01:11 PM
Why doesn't Dhoni in cell C11 have blank rows above it?

Paul_Hossler
07-04-2019, 01:56 PM
I think your 'Output' missed a Dhoni in C6



Option Explicit
Sub Format()
Dim rName As Range

With Worksheets("Input File")
Set rName = .Cells(.Rows.Count, 3).End(xlUp)

Do While rName.Row > 1

Select Case rName.Value
Case "Rohit", "Virat", "Dhoni"
With rName
.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With .Offset(-2, -1).Resize(1, 3).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
End With

Set rName = rName.Offset(-3, 0)

Case Else
Set rName = rName.Offset(-1, 0)
End Select
Loop

End With

End Sub

malleshg24
07-04-2019, 05:44 PM
Hi Paul,

Thanks you so much :thumb. lovely used offset and resize.
One more small help how to pass dynamically these names from Sheet3.range("a2:a"&lr).value
for line Case "Rohit", "Virat", "Dhoni"

Regards,
mg,

Paul_Hossler
07-04-2019, 06:06 PM
Try this



Option Explicit

Sub Format()
Dim rName As Range, rNames As Range
Dim aryNames As Variant
Dim sNames As String

Set rNames = Worksheets("Sheet3").Range("A1:A3") ' <<<<<<<<< Change
aryNames = Application.WorksheetFunction.Transpose(rNames)

sNames = Join(aryNames, "#")

With Worksheets("Input File")
Set rName = .Cells(.Rows.Count, 3).End(xlUp)

Do While rName.Row > 1

If InStr(sNames, rName.Value) > 0 Then
With rName
.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With .Offset(-2, -1).Resize(1, 3).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
End With

Set rName = rName.Offset(-3, 0)

Else
Set rName = rName.Offset(-1, 0)
End If
Loop

End With

End Sub

malleshg24
07-04-2019, 06:20 PM
Thanks you Sir,:friends::thumb