If then row height set macro

[doriannjeshi]

Hello,
I need for the cells that have content in column A if not duplicate value of the cell in column A to have row height of 30.

a111
a111
a111
a114
a115
a116
a117
a118
a119
a119
a118
a118
a118
a123
a124
a125

 

[DanteAmor]

I need a workaround in applying this macro 3 times in a bigger macro
with dim as.. as they are repetead .

Try
In the macro I put the comments so you know where to put each part of the macro.

Sub headerHeight2()

  'You only put this part once at the beginning of your big macro.
  'Start Part1
  Dim dic_v As Object
  Dim c_v As Range
  Dim itm_v As Variant
  
  Set dic_v = CreateObject("Scripting.Dictionary")
  'End Part1
  
  
  'You put this part wherever you want in your macro.
  'Start Part2
  For Each c_v In Range("A1", Range("A" & Rows.Count).End(3))
    If c_v.Value <> "" Then
      If Not dic_v.exists(c_v.Value) Then
        dic_v(c_v.Value) = c_v.Row
      End If
    End If
  Next
  For Each itm_v In dic_v.items
    Range("A" & itm_v).RowHeight = 30
  Next
  'End Part2
  
  
End Sub

 

[doriannjeshi]

as I already mentioned it is increasing the height of every cell that has a value in it , even though the value is not unique. I need the height adjustment only for the cells that are unique!

 

[DanteAmor]

I need the height adjustment only for the cells that are unique!

In the following example, before the macro, the unique values are marked in yellow.

After th macro. Only the unique values increased the size, that is, the rows: 2, 6, 10, 12, 14 y 16.

If that is not what you need, then, as I mentioned repeatedly, explain in your example which rows you want to increase.

 

[MARK858]

@DanteAmor in the highlighted cells a111, a118 and a119 are distinct not unique

 

[DanteAmor]

in the highlighted cells a111, a118 and a119 are distinct not unique

It's just that my head doesn't understand which rows should be increased.
Mark, since the OP does not want to say which rows should be incremented, it would be too much to ask of you if you told me, from my example in post #23, which rows should be incremented.

Thank you

 

[MARK858]

The only values where the rows should be increased are in the Unique column in the table below and highlighted

date file.xlsb
	A	B	C	D
1			Unique	Distinct
2	a111		a114	a111
3	a111		a115	a114
4	a111		a116	a115
5			a117	a116
6	a114			a117
7				a118
8	a115			a119
9
10	a116
11
12	a117
13
14	a118
15
16	a119
17	a119
18
19	a118
20	a118
21	a118
Sheet10

Cell Formulas
Range	Formula
D2:D12	D2	=IFERROR(INDEX($A$2:$A$21, MATCH(0, COUNTIF($D$1:D1, $A$2:$A$21&"") + IF($A$2:$A$21="",1,0), 0)), "")
C2:C16	C2	=IFERROR(INDEX($A$2:$A$21, MATCH(0,INDEX(COUNTIF($C$1:C1, $A$2:$A$21)+(COUNTIF($A$2:$A$21, $A$2:$A$21)<>1),0,0), 0)), "")

 

[DanteAmor]

The only values where the rows should be increased are in the Unique column in the table below and highlighted

Thanks Mark, sometimes you don't see it because your mind is somewhere else


Here is the correction to my macro, just so as not to leave my contribution unfinished.

Sub headerHeight2()

  'You only put this part once at the beginning of your big macro.
  'Start Part1
  Dim dic_v As Object
  Dim c_v As Range
  Dim itm_v As Variant
  
  Set dic_v = CreateObject("Scripting.Dictionary")
  'End Part1
  
  
  'You put this part wherever you want in your macro.
  'Start Part2
  For Each c_v In Range("A1", Range("A" & Rows.Count).End(3))
    If c_v.Value <> "" Then
      If Not dic_v.exists(c_v.Value) Then
        dic_v(c_v.Value) = c_v.Row
      Else
        dic_v.Remove (c_v.Value)
      End If
    End If
  Next
  For Each itm_v In dic_v.items
    Range("A" & itm_v).RowHeight = 30
  Next
  'End Part2
  
End Sub

 

[doriannjeshi]

Hi Dante,
it is still increasing the height of the duplicated values:
If in the column the value is repeated , the macro should not increase the height of that cell.
The macro should work only on the values that are not more than Once in the column

 

[DanteAmor]

it is still increasing the height of the duplicated values

Sorry, totally my fault, first for not understanding the requirement, then for not doing enough testing.

Try this:

Sub headerHeight2()

  'You only put this part once at the beginning of your big macro.
  'Start Part1
  Dim dic_v As Object
  Dim c_v As Range
  Dim itm_v As Variant
  Dim a_v As Variant
  Dim i_v As Long, n_v As Long
  Dim rng_v As Range
  
  Set dic_v = CreateObject("Scripting.Dictionary")
  'End Part1
  
  
  'You put this part wherever you want in your macro.
  'Start Part2
  a_v = Range("A1", Range("A" & Rows.Count).End(3)).Value
  For i_v = 1 To UBound(a_v, 1)
    dic_v(a_v(i_v, 1)) = dic_v(a_v(i_v, 1)) + 1
  Next
  
  For i_v = 1 To UBound(a_v, 1)
    n_v = dic_v(a_v(i_v, 1))
    If n_v = 1 Then
      If rng_v Is Nothing Then
        Set rng_v = Range("A" & i_v)
      Else
        Set rng_v = Union(rng_v, Range("A" & i_v))
      End If
    End If
  Next
  
  If Not rng_v Is Nothing Then
    rng_v.Select
    rng_v.RowHeight = 30
  End If
  'End Part2
  
End Sub

 

[doriannjeshi]

Hi Dante,
The macro works great by itself, Grazias

When I try to include it in the bigger macro though, I follow your instructions and put the first part on top of the macro (2000lines) and the second part wherever in 3 different places where I need the row height change. It failed in the 2cond replication