Consulting

Results 1 to 7 of 7

Thread: VBA - Merging and Bordering of cells if condition met....

  1. #1
    Banned VBAX Contributor
    Joined
    Aug 2017
    Posts
    144
    Location

    VBA - Merging and Bordering of cells if condition met....

    HTML Code:
    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.
    Attached Files Attached Files

  2. #2
    VBAX Expert Leith Ross's Avatar
    Joined
    Oct 2012
    Location
    San Francisco, California
    Posts
    552
    Location
    Hello malleshg24,

    Could another "abc , xyz" group ever follow the "abc , abc , abc , abc" group?
    Sincerely,
    Leith Ross

    "1N73LL1G3NC3 15 7H3 4B1L17Y 70 4D4P7 70 CH4NG3 - 573PH3N H4WK1NG"

  3. #3
    Banned VBAX Contributor
    Joined
    Aug 2017
    Posts
    144
    Location
    No sir, there will not. Thanks

    mg

  4. #4
    Banned VBAX Contributor
    Joined
    Aug 2017
    Posts
    144
    Location
    Slight change one extra row while bordering, it will be ABC ,xyz and one blank row then all these cells row in Border,

  5. #5
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    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
    Attached Files Attached Files
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  6. #6
    Banned VBAX Contributor
    Joined
    Aug 2017
    Posts
    144
    Location
    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

  7. #7
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Quote Originally Posted by malleshg24 View Post
    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
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •