excelvba

Update cell value based on another cell VBA

Illutration Purpose only.

I have two data range. 1st range is B4 to B18 and 2nd range are D3 to F7

and I am using below VBA code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngCell As Range
If Application.Intersect(Target, Range("D3:F7")) Is Nothing Then GoTo check2:
For Each rngCell In Intersect(Target, Range("D3:F7"))
Application.EnableEvents = False

rngCell.Value = StrConv(rngCell, vbProperCase)

Range("B4").Value = Range("D3").Value
Range("B5").Value = Range("D4").Value
Range("B6").Value = Range("D5").Value
Range("B7").Value = Range("D6").Value
Range("B8").Value = Range("D7").Value
Range("B9").Value = Range("E3").Value
Range("B10").Value = Range("E4").Value
Range("B11").Value = Range("E5").Value
Range("B12").Value = Range("E6").Value
Range("B13").Value = Range("E7").Value
Range("B14").Value = Range("F3").Value
Range("B15").Value = Range("F4").Value
Range("B16").Value = Range("F5").Value
Range("B17").Value = Range("F6").Value
Range("B18").Value = Range("F7").Value
Application.EnableEvents = True

Next
check2:
End Sub

If I type anything in my second range, it should automatically update to my first range.

My problem is that, is there any short way to write this code. because in future I will increase my range area.

Please help.

Solution

  • You can replace all of your Range("xx).Value = Range("yy").Value lines with just one line:

    Cells(1 + rngCell.Row + (rngCell.Column - 4) * 5, 2) = rngCell.Value

    This converts the co-ordinates of each target cell into a position on column B.

    Making things a little more flexible as you mentioned changing the size of the range:

    Private Sub Worksheet_Change(ByVal Target As Range)

    Dim TrgRng As Range
    Set TrgRng = Range("D3:F7") ' change F7 to suit
    
    If Application.Intersect(Target, TrgRng) Is Nothing Then GoTo check2:
    
    Dim rngCell As Range
    For Each rngCell In Intersect(Target, TrgRng)
        Application.EnableEvents = False
        rngCell.Value = StrConv(rngCell, vbProperCase)
        Cells(1 + rngCell.Row + (rngCell.Column - 4) * TrgRng.Rows.Count, 2) = rngCell.Value
        Application.EnableEvents = True
    Next
check2:
End Sub