Excel VBA - merge cells if values in columns equals - vba

Question

I'm trying to figure out how to implement a macro to get results as follows:
I have no idea how to do it. This is what I've done so far.
I want to have additional column "Action" and if value in column "State" for e.g R1 is empty or "no_fix" then QM (green) else QA (red).
I have data with ~5000 rows
Hi, thanks it works as I expected. However, after testing of my data it turned out that I need to check additional conditions.
1.Additionally for QM and QA:
check in column G if value = "ST"
check in column H if value = 0
2.QA
check in column C if value = "No TC for LM" check in column D if
value = "no state" check in column E if value = "No IPIS" if any of
values = true then QA
Sub MergeSameCell()
'area
Dim Rng As Range, xCell As Range, Test As Range
Dim Rng1 As Range
Dim xRows As Integer
xTitleId = "Merge duplicated cells"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address,
Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xRows = WorkRng.Rows.Count
For Each Rng In WorkRng.Columns
For i = 1 To xRows - 1
For j = i + 1 To xRows
'If Rng.Cells(i, 1).Value > 0 And Rng.Cells(j, 1).Value > 0 Then
If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then
Exit For
End If
Next
'WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge
'Text = WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1))
i = j - 1
For Each Rng1 In Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1))
For Z = 1 To 13
'MsgBox i
'MsgBox j
If Rng1.Offset(Z, 1).Value = "no_to_fix" Or Rng1.Offset(Z,
1).Value
= "" Then
'WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1,
1)).Merge
Rng1.Cells.Offset(Z, 1).Interior.ColorIndex = 37
'MsgBox "supcio"
End If
Next
Next
Next
Next
WorkRng.VerticalAlignment = xlCenter
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Answer 1

The following code will do the merging you want and, if I understand what you mean by the second part of the question, will set the first column to be either "QM" (if the fourth column is never anything other than blank or "no_fix") or "QA".
Code assumes you will use the InputBox to select a range containing four columns, the first being the column that will contain "QM" or "QA", the second being the column that is your "Req" column, and the fourth being your "State" column. (The code never looks at what is in the third column.)
Sub MergeSameCell()
Dim WorkRng As Range
xTitleId = "Merge duplicated cells"
Set WorkRng = Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim startRow As Long
Dim endRow As Long
Dim r As Long
Dim isQM As Boolean
'Use "startRow" to keep track of the start of each block
startRow = 1
With WorkRng
'Loop through each row in the selected range
For endRow = 1 To .Rows.Count
If .Cells(endRow + 1, 2).Value <> .Cells(startRow, 2).Value Then
'Only do something if the next row has a different value in the second column
'merge rows in the first and second columns
.Worksheet.Range(.Cells(startRow, 1), .Cells(endRow, 1)).MergeCells = True
.Worksheet.Range(.Cells(startRow, 2), .Cells(endRow, 2)).MergeCells = True
'Check for "no_fix" or blank
isQM = True ' Assume it is a "QM" until we determine it isn't
For r = startRow To endRow
If .Cells(r, 4).Value <> "" And .Cells(r, 4).Value <> "no_fix" Then
'If the 4th column is not blank and is not "no_fix", it isn't a "QM"
isQM = False
Exit For
End If
Next
'Update column 1 to show QM or QA
With .Cells(startRow, 1)
If isQM Then
.Value = "QM"
.Interior.Color = vbGreen
Else
.Value = "QA"
.Interior.Color = vbRed
End If
End With
'Point to start of next block
startRow = endRow + 1
End If
Next
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub