PDA

View Full Version : VBA - Merging and Bordering of cells if condition met....



malleshg24
07-02-2019, 07:32 PM
Hi Team,
I need your help, Task is to read the cell values from Column C of input file on by one till LastRow.
if range("c3") = "ABC" and range("c4") = "XYZ" then insert a blank line below c4.and Range("C3:C4") needs a Border as shown in Output sheet.
and in Column A3 mention Situation 1. merge cell ("A3:A4") Increase Situation 1,2,3 and so on...
Usually at last we will not come across abc and xyz simultaneously. then remaining data should bebordered like a box.
I am attaching input data file , I want the result in input sheet only, not in a output sheet.
Thanks for your help.
Regards,MG.

Leith Ross
07-02-2019, 10:46 PM
Hello malleshg24,

Could another "abc , xyz" group ever follow the "abc , abc , abc , abc" group?

malleshg24
07-02-2019, 10:56 PM
No sir, there will not. Thanks

mg

malleshg24
07-02-2019, 11:28 PM
Slight change one extra row while bordering, it will be ABC ,xyz and one blank row then all these cells row in Border,

p45cal
07-03-2019, 05:48 AM
Code in the attached, run by button click on Sheet1:
Sub Test()
Dim lr As Long, i As Long, sht As Worksheet, wbk As Workbook
Dim TopDataCellRow As Long, nextbr As Long, SituationCount As Long, cll As Range

Set wbk = ThisWorkbook
Set sht = wbk.Worksheets("Sheet1")
TopDataCellRow = 3
With sht
lr = .Range("b65000").End(xlUp).Row
nextbr = lr + 1
For i = lr To TopDataCellRow Step -1
If .Cells(i, 3).Value = "XYZ" Then
If .Cells(i - 1, 3).Value = "ABC" Then
.Cells(i + 1, 3).EntireRow.Insert
lr = lr + 1
With .Range(.Cells(nextbr, "C"), .Cells(i + 2, "B"))
.BorderAround , 4
.Offset(, -1).Resize(, 1).BorderAround , 4
.Offset(, -1).Resize(, 1).MergeCells = True
.Offset(, -1).Cells(1).Value = "¬`"
nextbr = i + 2
End With
End If
End If
If i = TopDataCellRow Then
With .Range(.Cells(nextbr - 1, 3), .Cells(TopDataCellRow, 2))
.BorderAround , 4
.Offset(, -1).Resize(, 1).BorderAround , 4
.Offset(, -1).Resize(, 1).MergeCells = True
.Offset(, -1).Cells(1).Value = "¬`"
End With
.Cells(TopDataCellRow - 1, "B").Resize(, 2).ClearContents
End If
Next i
SituationCount = 0
For Each cll In .Range("A" & TopDataCellRow & ":A" & lr).Cells
If cll.Value = "¬`" Then
SituationCount = SituationCount + 1
cll.Value = "Situation " & SituationCount
End If
Next cll
End With
End Sub

malleshg24
07-04-2019, 09:44 AM
Hi Leith /P45Cal

you guys are geneous,Thanks for help.
Is there a way to re-upload a workbook if there is any modification suggested by our BA. in quick reply don't find this Option.

Regards,
mg

p45cal
07-04-2019, 12:18 PM
Is there a way to re-upload a workbook if there is any modification suggested by our BA. in quick reply don't find this Option.Only with Go Advanced which you can do from Quick Reply