Quantcast
Channel: Excel Help Forum - Excel Programming / VBA / Macros
Viewing all articles
Browse latest Browse all 49892

Merge cells based on the cell value updated on other column

$
0
0
Dear Tram,

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

My code is
Code:

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

Viewing all articles
Browse latest Browse all 49892

Trending Articles