Merge columns where cells have same values, excluding "0"s [closed] - vba

Question

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 5 years ago.
Improve this question
I've seen many questions on merging, but nothing that I can manipulate (in my entry-level abilities) to answer this particular question and would be forever be grateful for your expertise and help!!!
I am looking to merge different groups of cells with the same values for particular ranges.
Below is an example of inputs and the desired outcome. I have the file formatted so that the "0"s and "no"s don't show, however the actual descriptions (substituted with like 50% off) are quite long and cannot be viewed in a single cell, hence the need for merge cells to better display information. There are also multiple stores with new stores being added weekly, thus I would like to avoid merging cells manually.
Input
Month January February March April May
Store 1 Campaign Period no yes yes yes no
Campaign Details 0 50% off 50% off 50% off 0
Store 2 Campaign Period no no no yes yes
Campaign Details 0 0 0 spring fling spring fling
Desired Output
Month January February March April May
Store 1 Campaign Period no yes yes yes no
Campaign Details 0 50% off 0
Store 2 Campaign Period no no no yes yes
Campaign Details 0 0 0 spring fling

Answer 1

This should get you started. The data is assumed to be in "Sheet1". It will merge cells in rows that are labeled with "Campaign Details" in Column 'A'. The merge is performed on adjacent row cells that have the same value - at least two adjacent cells with the same value will be merged.
Option Explicit
Sub MergeSameDetails()
Dim sht As Worksheet
Set sht = Worksheets("Sheet1")
Application.DisplayAlerts = False
With sht
Dim lastrow As Integer, i As Integer, j As Integer, cnt As Integer
Dim val As Variant
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To lastrow
If .Cells(i, "A").Value = "Campaign Details" Then
cnt = 1
val = .Cells(i, 2).Value
For j = 3 To 7
If val = .Cells(i, j).Value Then
cnt = cnt + 1
Else
If cnt >= 2 And val <> "0" Then
.Range(Cells(i, j - cnt), Cells(i, j - 1)).Merge
.Cells(i, j - cnt).HorizontalAlignment = xlCenter
End If
cnt = 1
val = .Cells(i, j).Value
End If
Next
End If
Next
End With
Application.DisplayAlerts = True
End Sub