Consulting

Results 1 to 2 of 2

Thread: Merge cells based on the cell value updated on other column

  1. #1
    VBAX Contributor
    Joined
    Jun 2019
    Posts
    155
    Location

    Merge cells based on the cell value updated on other column

    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

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Cross-posted at: https://www.excelforum.com/excel-pro...er-column.html
    Please read VBA Express' policy on Cross-Posting in Rule 3: http://www.vbaexpress.com/forum/faq...._new_faq_item3
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Posting Permissions

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