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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.