multiple merge vary number of cells in 1st column (conditions). 1

[ogniemi]

Hello,

the first column in the excel is empty.

I use the following script to automatically colour group of rows (rows were sorted by column D, and then gruped by the same value in that column and the coloured alternately using the vbscript).

Public Sub HighLightRows()
Dim i As Integer
i = 2
Dim c As Integer
c = 2 'Light yellow
Dim tem_val As Integer
temp_val = 0
Do While (Cells(i, 5) <> "")
temp_val = Cells(i, 4)
If (Cells(i - 1, 4) <> temp_val) Then 'check for different value
If c = 2 Then
c = 15 'Grey
Else
c = 2 'Light yellow
End If
End If
Rows(Trim(Str(i)) + ":" + Trim(Str(i))).Interior.ColorIndex = c
i = i + 1
Loop
End Sub

Now I need to count number of groups. I wanted to merge cells in first column belonging to each group additionally number those groups by 1,2,3,4....

It would also be fine if each row in a group is numbered in the first column (so in each 1st cell of the 1st group there are "1", in second group there are "2", etc...)


thx for any hint in advance,
rm.

 

[PHV]

A starting point:

Public Sub HighLightRows()
Dim i As Integer
i = 2
Dim c As Integer
c = 2  'Light yellow
Dim tem_val As Integer
[!]Do While (Cells(i, 5) <> "")[/!]
  temp_val = Cells(i, 4)
  If (Cells(i - 1, 4) <> temp_val) Then  'check for different value
    If c = 2 Then
      c = 15  'Grey
    Else
      c = 2  'Light yellow
    End If
    [!]intGroup = intGroup + 1[/!]
  End If
  [!]Cells(i, 1) = intGroup[/!]
  Rows(Trim(Str(i)) + ":" + Trim(Str(i))).Interior.ColorIndex = c
  i = i + 1
Loop
End Sub

FYI, your code isn't vbscript but VBA.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[PHV]

OOps, I've messed the highlighting:

Public Sub HighLightRows()
Dim i As Integer
i = 2
Dim c As Integer
c = 2  'Light yellow
Dim temp_val As Integer
[!]Dim intGroup As Integer[/!]
Do While (Cells(i, 5) <> "")
  temp_val = Cells(i, 4)
  If (Cells(i - 1, 4) <> temp_val) Then  'check for different value
    If c = 2 Then
      c = 15  'Grey
    Else
      c = 2  'Light yellow
    End If
    [!]intGroup = intGroup + 1[/!]
  End If
  [!]Cells(i, 1) = intGroup[/!]
  Rows(Trim(Str(i)) + ":" + Trim(Str(i))).Interior.ColorIndex = c
  i = i + 1
Loop
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886