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

 

[HighAndWilder]

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

This will change the row height to 30 for unique entries.

Test it on a copy of the data where the sheet is the active sheet.

Public Sub subSetRowheight()
Dim arr() As Variant
Dim i As Integer

  arr = Evaluate("UNIQUE(A:A,FALSE,TRUE)")
  
  For i = LBound(arr) To UBound(arr)
    Range("A" & Range("A:A").Find(what:=arr(i, 1)).Row).EntireRow.RowHeight = 30
  Next i
  
End Sub

 

[doriannjeshi]

I get this

if I remove the header

 

[HighAndWilder]

I get this

View attachment 119992
if I remove the header
View attachment 119993

Try this:

Public Sub subSetRowheight()
Dim arr() As Variant
Dim i As Integer

  arr = Evaluate("UNIQUE(FILTER(A:A,A:A<>""""),FALSE,TRUE)")
  
  For i = LBound(arr) To UBound(arr)
    Range("A" & Range("A:A").Find(what:=arr(i, 1)).Row).EntireRow.RowHeight = 30
  Next i
  
End Sub

 

[HighAndWilder]

I get this

View attachment 119992
if I remove the header
View attachment 119993

Or this WITH the header.

Public Sub subSetRowheight()
Dim arr() As Variant
Dim i As Integer
Dim rng As Range
  
  Set rng = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)

  arr = Evaluate("UNIQUE(FILTER(" & rng.Address & "," & rng.Address & "<>""""),FALSE,TRUE)")
  
  For i = LBound(arr) To UBound(arr)
    Range("A" & Range("A:A").Find(what:=arr(i, 1)).Row).EntireRow.RowHeight = 30
  Next i
  
End Sub

 

[doriannjeshi]

mismatch

 

[doriannjeshi]

Or this WITH the header.

Public Sub subSetRowheight()
Dim arr() As Variant
Dim i As Integer
Dim rng As Range
 
  Set rng = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)

  arr = Evaluate("UNIQUE(FILTER(" & rng.Address & "," & rng.Address & "<>""""),FALSE,TRUE)")
 
  For i = LBound(arr) To UBound(arr)
    Range("A" & Range("A:A").Find(what:=arr(i, 1)).Row).EntireRow.RowHeight = 30
  Next i
 
End Sub

with the Header is the wanted result
Thank you

 

[doriannjeshi]

One question
Since is a long macro I have duplicates of dim i as ...
can I edit that to another letter ad dim S ?

 

[HighAndWilder]

mismatch
View attachment 119994

One question
Since is a long macro I have duplicates of dim i as ...
can I edit that to another letter ad dim S ?

Yes but the variable i, or any variable, can be used for multiple purposes in the same procedure.

I'd just delete the redundant line.

 

[DanteAmor]

Here another macro for you to consider:

Sub headerHeight()
  Dim ar As Range
 
  For Each ar In Range("A2", Range("A" & Rows.Count).End(3)).SpecialCells(xlCellTypeConstants).Areas
    ar.Cells(1).RowHeight = 30
  Next
End Sub