PDA

View Full Version : Merge cells based on the cell value updated on other column



elsuji
01-24-2020, 11:33 AM
Dear Tram,

I am having problem on copy paste value on there sheet.

My code is
Dim actWsh As String Dim sh As Worksheet, ws As Worksheet
Dim LstRw As Long, Frng As Range, c As Range
Dim lItem As Integer
Dim Index As String
Set ws = Sheets("Schedule")
actWsh = ComboBox2.Text
Set sh = Sheets("Topics")
With ws
LstRw = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
With .Range(.Cells(LstRw + 1, 1), .Cells(LstRw + 15, 1))
.Merge
.BorderAround , xlThin
End With
.Cells(LstRw + 1, 1) = CDate(Me.TextBox1.Value)
.Cells(LstRw + 1, 1).VerticalAlignment = xlCenter
.Cells(LstRw + 1, 1).HorizontalAlignment = xlCenter
End With
With ws
LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
With .Range(.Cells(LstRw + 1, 4), .Cells(LstRw + 15, 4))
.Merge
.BorderAround , xlThin
End With
.Cells(LstRw + 1, 4) = ComboBox2.Value
.Cells(LstRw + 1, 4).VerticalAlignment = xlCenter
.Cells(LstRw + 1, 4).HorizontalAlignment = xlCenter
End With
With ws
LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
With .Range(.Cells(LstRw + 1, 5), .Cells(LstRw + 15, 5))
.Merge
.BorderAround , xlThin
End With
.Cells(LstRw + 1, 5) = ComboBox3.Value
.Cells(LstRw + 1, 5).VerticalAlignment = xlCenter
.Cells(LstRw + 1, 5).HorizontalAlignment = xlCenter
End With
With ws
LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
With .Range(.Cells(LstRw + 1, 6), .Cells(LstRw + 15, 6))
.Merge
.BorderAround , xlThin
End With
.Cells(LstRw + 1, 6) = ComboBox4.Value
.Cells(LstRw + 1, 6).VerticalAlignment = xlCenter
.Cells(LstRw + 1, 6).HorizontalAlignment = xlCenter
End With
With ws
LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
With .Range(.Cells(LstRw + 1, 8), .Cells(LstRw + 15, 8))
.Merge
.BorderAround , xlThin
End With
.Cells(LstRw + 1, 8) = ComboBox5.Value
.Cells(LstRw + 1, 8).VerticalAlignment = xlCenter
.Cells(LstRw + 1, 8).HorizontalAlignment = xlCenter
End With


For lItem = 0 To UserForm3.ListBox1.ListCount - 1
If UserForm3.ListBox1.Selected(lItem) Then
If Index <> vbNullString Then Index = Index & " / "
Index = Index & UserForm3.ListBox1.List(lItem)
End If
With ws
LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
With .Range(.Cells(LstRw + 1, 7), .Cells(LstRw + 15, 7))
.Merge
.BorderAround , xlThin
.WrapText = True
End With
.Cells(LstRw + 1, 7) = Index
.Cells(LstRw + 1, 7).VerticalAlignment = xlCenter
.Cells(LstRw + 1, 7).HorizontalAlignment = xlCenter
End With
Next


x = 1
With sh
Set Frng = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
For Each c In Frng.Cells
If x < 16 Then
If .Cells(c.Row, "E") = Me.ComboBox3 And .Cells(c.Row, "C") = Me.ComboBox2 Then
If c.EntireRow.Hidden = False Then
.Range("A" & c.Row & ":B" & c.Row).Copy ws.Cells(LstRw + x, 2)
c.EntireRow.Hidden = True
x = x + 1
End If
End If
End If
Next c
End With

on my above code i am merging 15 nos of cell by default.

But i want to merge only according to values updated on column B & C.

can any one please help me

macropod
04-19-2020, 03:00 PM
Cross-posted at: https://www.excelforum.com/excel-programming-vba-macros/1303822-merge-cells-based-on-the-cell-value-updated-on-other-column.html
Please read VBA Express' policy on Cross-Posting in Rule 3: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_new_faq_item3