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

A

Atlantis764

New Member
Joined
Jan 10, 2022
Messages
21
Office Version
  1. 2019
Platform
  1. Windows
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
AB
1CategoryDescription
2COConcediu de odihna
3A2.3
4
5
6
7
8
9
10
Sheet1
Cells with Data Validation
CellAllowCriteria
A2:A10List=Sheet2!$A$1:$D$1


Test_17.11.2024.xlsm
ABCD
1A2.1A2.2A2.3CO
2A2.1 Organizarea procesului de elaborare a standardele de evaluareA2.2 Achiziția serviciilor externalizate pentru analiză sistem, instruire/formare, suport tehnic, monitorizare, pilotare și validare a standardelor de evaluareA2.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 gimnazialConcediu de odihna
Sheet2


VBA Code: 
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
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
Try.
VBA 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"
            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
 
Upvote 0
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
AB
1CategoryDescription
2A2.1A2.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
3A2.2
4A2.3
5A2.3
6
7
8
9
10
Sheet1
Cells with Data Validation
CellAllowCriteria
A2:A10List=Sheet2!$A$1:$D$1
B2:B10List$D$1:$F$1

Test_17.11.2024.xlsm
ABCD
1A2.1A2.2A2.3CO
2A2.1 Organizarea procesului de elaborare a standardele de evaluareA2.2 Achiziția serviciilor externalizate pentru analiză sistem, instruire/formare, suport tehnic, monitorizare, pilotare și validare a standardelor de evaluareA2.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 gimnazialConcediu de odihna
Sheet2
 
Upvote 0
TRy.
VBA 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"
            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
 
Upvote 0
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!
 
Upvote 0
Try.
VBA 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.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
 
Upvote 0
Modified Code:
VBA 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
 
Upvote 0
Solution
You must log in or register to reply here.

Forum statistics

Threads
1,224,820
Messages
6,181,162
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top