Insert Two Blank Row if Condition Met

[malleshg24]

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]

Why doesn't Dhoni in cell C11 have blank rows above it?

[Paul_Hossler]

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]

Hi Paul,

Thanks you so much . 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]

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]

Thanks you Sir,