Row Height adjusted based on content - not for a cell but for a range of cells

[Atlantis764]

Hello Team,
I need your support with the following problem:
- in cell A2 (sheet 1) I have a drop-down list from range A1:D1 (sheet 2)
- in cell B2 (sheet 1) is the description of the value of cell A2 (dependent drop-down list)
I managed to find a VBA code in other threads that will adjust the B2 cell height based on the content of the cell.
The drop-down list from column A is applied for the range A2:A10.
The problem that I have now is that I don't know how to apply the same code for all the cells from B2 to B10 (range B2:B10).
Could you help me with that?
Many thanks in advance!

Test_17.11.2024.xlsm
	A	B
1	Category	Description
2	CO	Concediu de odihna
3	A2.3
4
5
6
7
8
9
10
Sheet1

Cells with Data Validation
Cell	Allow	Criteria
A2:A10	List	=Sheet2!$A$1:$D$1

Test_17.11.2024.xlsm
	A	B	C	D
1	A2.1	A2.2	A2.3	CO
2	A2.1 Organizarea procesului de elaborare a standardele de evaluare	A2.2 Achiziția serviciilor externalizate pentru analiză sistem, instruire/formare, suport tehnic, monitorizare, pilotare și validare a standardelor de evaluare	A2.3 Analiza sistemului educațional din perspectiva procesului de evaluare (realizare: plan-cadru al evaluărilor, metodologie elaborare, pilotare și validare standarde) pentru ciclul primar si cel gimnazial	Concediu de odihna
Sheet2

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, Range("A2")) Is Nothing Then Exit Sub
    
    Select Case Target.Value
        Case "A2.1"
            Range("B2").WrapText = True
            Range("B2") = "A2.1 Organizarea procesului de  elaborare a standardele de evaluare"
        Case "A2.2"
            Range("B2").WrapText = True
            Range("B2") = "A2.2 Achizitia serviciilor externalizate pentru analiza sistem, instruire/formare, suport tehnic, monitorizare, pilotare si validare a standardelor de evaluare"
        Case "A2.3"
            Range("B2").WrapText = True
            Range("B2") = "A2.3 Analiza sistemului educational din perspectiva procesului de evaluare (realizare: plan-cadru al evaluarilor, metodologie elaborare, pilotare si validare standarde) pentru ciclul primar si cel gimnazial"
        Case "CO"
            Range("B2").WrapText = True
            Range("B2") = "Concediu de odihna"
    End Select

    If Intersect(Target, Range("A3")) Is Nothing Then Exit Sub

    Select Case Target.Value
        Case "A2.1"
            Range("B3").WrapText = True
            Range("B3") = "A2.1 Organizarea procesului de  elaborare a standardele de evaluare"
        Case "A2.2"
            Range("B3").WrapText = True
            Range("B3") = "A2.2 Achizitia serviciilor externalizate pentru analiza sistem, instruire/formare, suport tehnic, monitorizare, pilotare si validare a standardelor de evaluare"
        Case "A2.3"
            Range("B3").WrapText = True
            Range("B3") = "A2.3 Analiza sistemului educational din perspectiva procesului de evaluare (realizare: plan-cadru al evaluarilor, metodologie elaborare, pilotare si validare standarde) pentru ciclul primar si cel gimnazial"
        Case "CO"
            Range("B3").WrapText = True
            Range("B3") = "Concediu de odihna"
    End Select

End Sub

 

[kvsrinivasamurthy]

Try.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, Range("A2:A10")) Is Nothing Then Exit Sub
    
    Select Case Target.Value
        Case "A2.1"
            Range("B2").WrapText = True
            Range("B2") = "A2.1 Organizarea procesului de  elaborare a standardele de evaluare"
        Case "A2.2"
            Range("B2").WrapText = True
            Range("B2") = "A2.2 Achizitia serviciilor externalizate pentru analiza sistem, instruire/formare, suport tehnic, monitorizare, pilotare si validare a standardelor de evaluare"
        Case "A2.3"
            Range("B2").WrapText = True
            Range("B2") = "A2.3 Analiza sistemului educational din perspectiva procesului de evaluare (realizare: plan-cadru al evaluarilor, metodologie elaborare, pilotare si validare standarde) pentru ciclul primar si cel gimnazial"
        Case "CO"
            Range("B2").WrapText = True
            Range("B2") = "Concediu de odihna"
    End Select
    Target.EntireRow.AutoFit
End Sub

 

[Atlantis764]

Thanks for your reply!
I've tried the code sent by you but it doesn't work.
The result now is: if I change any cell in range A2:A10 will have the dependent result only in cell B2. If I change cell A8 the result is correct in B2.
I want for example if I select cell A8 with "CO" from sheet 2 (Cell D1) to have in cell B8 "Concediu de odihna" (cell D2 from sheet 2). If I change A5 to have the dependent result in B5 and so on (for all range B2:B10).

Test_17.11.2024.xlsm
	A	B
1	Category	Description
2	A2.1	A2.3 Analiza sistemului educational din perspectiva procesului de evaluare (realizare: plan-cadru al evaluarilor, metodologie elaborare, pilotare si validare standarde) pentru ciclul primar si cel gimnazial
3	A2.2
4	A2.3
5	A2.3
6
7
8
9
10
Sheet1

Cells with Data Validation
Cell	Allow	Criteria
A2:A10	List	=Sheet2!$A$1:$D$1
B2:B10	List	$D$1:$F$1

Test_17.11.2024.xlsm
	A	B	C	D
1	A2.1	A2.2	A2.3	CO
2	A2.1 Organizarea procesului de elaborare a standardele de evaluare	A2.2 Achiziția serviciilor externalizate pentru analiză sistem, instruire/formare, suport tehnic, monitorizare, pilotare și validare a standardelor de evaluare	A2.3 Analiza sistemului educațional din perspectiva procesului de evaluare (realizare: plan-cadru al evaluărilor, metodologie elaborare, pilotare și validare standarde) pentru ciclul primar si cel gimnazial	Concediu de odihna
Sheet2

 

[kvsrinivasamurthy]

TRy.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, Range("A2:A10")) Is Nothing Then Exit Sub
    
    Select Case Target.Value
        Case "A2.1"
            Range("B2").WrapText = True
            Range("B2") = "A2.1 Organizarea procesului de  elaborare a standardele de evaluare"
        Case "A2.2"
            Range("B2").WrapText = True
            Range("B2") = "A2.2 Achizitia serviciilor externalizate pentru analiza sistem, instruire/formare, suport tehnic, monitorizare, pilotare si validare a standardelor de evaluare"
        Case "A2.3"
            Range("B2").WrapText = True
            Range("B2") = "A2.3 Analiza sistemului educational din perspectiva procesului de evaluare (realizare: plan-cadru al evaluarilor, metodologie elaborare, pilotare si validare standarde) pentru ciclul primar si cel gimnazial"
        Case "CO"
            Range("B2").WrapText = True
            Range("B2") = "Concediu de odihna"
    
    End Select
    Target.Offset(0, 1).WrapText = True
    Target.EntireRow.AutoFit
End Sub

 

[Atlantis764]

Unfortunately I have the same result with the code provided.
If I change any cell in range A2:A10 the result is only in cell B2.
I need the result to be in the correspondent cell for each row - if I change cell A5 the result must be in cell B5, for cell A9 the result in B9 an so on.
Thanks!

 

[kvsrinivasamurthy]

Try.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, Range("A2:A10")) Is Nothing Then Exit Sub
    
    Select Case Target.Value
        Case "A2.1"
            Target.Offset(0, 1) = Target & " Organizarea procesului de  elaborare a standardele de evaluare"
        Case "A2.2"
            Target.Offset(0, 1) = Target.Offset(0, 1) = Target & " Achizitia serviciilor externalizate pentru analiza sistem, instruire/formare, suport tehnic, monitorizare, pilotare si validare a standardelor de evaluare"
        Case "A2.3"
            Target.Offset(0, 1) = Target.Offset(0, 1) = Target & " Analiza sistemului educational din perspectiva procesului de evaluare (realizare: plan-cadru al evaluarilor, metodologie elaborare, pilotare si validare standarde) pentru ciclul primar si cel gimnazial"
        Case "CO"
           Target.Offset(0, 1) = "Concediu de odihna"
    End Select
    Target.Offset(0, 1).WrapText = True
    Target.EntireRow.AutoFit
End Sub

 

[kvsrinivasamurthy]

Modified Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, Range("A2:A10")) Is Nothing Then Exit Sub
    
    Select Case Target.Value
        Case "A2.1"
            Target.Offset(0, 1) = Target & " Organizarea procesului de  elaborare a standardele de evaluare"
        Case "A2.2"
            Target.Offset(0, 1)  = Target & " Achizitia serviciilor externalizate pentru analiza sistem, instruire/formare, suport tehnic, monitorizare, pilotare si validare a standardelor de evaluare"
        Case "A2.3"
            Target.Offset(0, 1)  = Target & " Analiza sistemului educational din perspectiva procesului de evaluare (realizare: plan-cadru al evaluarilor, metodologie elaborare, pilotare si validare standarde) pentru ciclul primar si cel gimnazial"
        Case "CO"
           Target.Offset(0, 1) = "Concediu de odihna"
    End Select
    Target.Offset(0, 1).WrapText = True
    Target.EntireRow.AutoFit
End Sub

 

[Atlantis764]

Thanks so much for all your help and support!

 

[kvsrinivasamurthy]

welcome.