CODEWITHSUNDEEP
vbaexcel
Tony Y
Tony Y

Reputation: 9

How to merge cell in a column if cell above it has content but itself is blank

Here is what trouble me:

For cells in column P, for example P3, if both P2 & B3 is not blank, but P3 is blank, then merge P2 with P3. And go on next cell in column P until respective cell in column B(for instance: B8) is blank, then stop.

       B      ....      P
 1  Monitor            Tom
 2   Mouse             Ann
 3  Keyboard
 4  Sticker
 5  Speaker            John
 6   Cable
 7    Fan              Rose
 8

So for table above, I want to merge P2:P4 & P5:P6. I've tried several time with my poor vba skill, but failed...

This code is what I've found in this website, and I've tried to edit it and see if this can solve my problem, but it doesn't work...

Sub Merge()
LR = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 To LR
If ActiveSheet.Cells(i, 1).Value <> "" And ActiveSheet.Cells(i + 1, 1).Value = "" And ActiveSheet.Cells(i + 1, 2).Value <> "" Then
   u = i + 1
   Do While ActiveSheet.Cells(u, 1).Value = "" And ActiveSheet.Cells(u, 2) <> ""
        u = u + 1
    Loop
    ActiveSheet.Range("A" & i & ":A" & (u - 1)).Select
    With Selection
        .Merge
        .BorderAround Weight:=xlMedium
        .WrapText = True
        '.VerticalAlignment = x1VAlignTop
        '.HorizontalAlignment = xlLeft
    End With
    Sheets(DataSheet).Range("B" & i & ":B" & (u - 1)).BorderAround Weight:=xlMedium
    i = u + 1
End If

Next i End Sub

Upvotes: 0

Views: 516

Answers (1)

Julian Kuchlbauer
Julian Kuchlbauer

Reputation: 895

Try this:

Dim i As Integer, a As String, b As String, c As Integer, d  As Integer
i = 11
a = "B"
b = "P"
c = 0
d = 0
While Range(a & i) <> ""
    If Range(b & i) = "" Then
        If c = 0 And i > 1 Then
            c = i - 1
            d = 1
        Else
            d = d + 1
        End If
    Else
        If c > 0 And d > 0 Then
            Range(b & c & ":" & b & (c + d)).Merge
        End If
        c = 0
        d = 0
    End If
    i = i + 1
Wend
If c > 0 And d > 0 Then
    Range(b & c & ":" & b & (c + d)).Merge
End If

Upvotes: 1

Related Questions