VB Function for Copy & Paste

[sivakr68]

Hi


Need some assistance in creating a function in Excel 2007.
Attached is a sample of a table I am working with Actual data table and Stored data table.


In the first table in cell B2..G2, that has formula which are based on live data. When the formula is correct, it will display a figure and when it is not, it will display blank. The rest of the rows 3 to 8 will populate accordingly based on row 2.


Anyway, I need to create a function that
• When cell B2 (for example) gets populated, the function will copy B2..B8 and paste to B11..B17. Each Column is independent of each other.


• When B2 goes blank, data in B11..B17 will still remain. For example in column F, the cell F2 is blank but the data in F11..F17 is still there.


• When B2 get populated again, it will overwrite cells B11..B17.


• If the date and time (row 7 & 8) can work with the function, it would be great.


Thanks in Advance
Regards


SivaK

[Bob Phillips]

Use this worksheet event code

Private Sub Worksheet_Change(ByVal Target As Range)


    On Error GoTo ws_exit
    
    Application.EnableEvents = False
    
    If Target.Address = "$B$2" Then
    
    
        If Target.Value <> "" Then
        
            Target.Resize(6).Copy Me.Range("B11")
        End If
    End If


ws_exit:
    Application.EnableEvents = True
End Sub

[sivakr68]

Hi Bob

Thanks for your reply.

The event code works but it only works for one cell.

In my table when B2 get populated, the function will copy Cells from B2..B8 (7 cells) to B11..B17.
And it should also work for the other columns.

Thanks for you assistance.

Regards

[Bob Phillips]

So, extend it

Private Sub Worksheet_Change(ByVal Target As Range)


    On Error GoTo ws_exit
    
    Application.EnableEvents = False
    
    If Target.Address = "$B$2" Then
    
    
        If Target.Value <> "" Then
        
            Target.Resize(6, 7).Copy Me.Range("B11")
        End If
    End If

ws_exit:
    Application.EnableEvents = True
End Sub

[sivakr68]

Hi Bob

Sorry, the first code works with Resize(6).

Question: To use for columns C to Z, I just duplicate the IF statement ? So if I have 100 columns, I should have 100 if Statements. ?


Thanks

Regards

Siva

[Bob Phillips]

Is this what you mean

Private Sub Worksheet_Change(ByVal Target As Range)




    On Error GoTo ws_exit
    
    Application.EnableEvents = False
    
    If Not Intersect(Target, Me.Range("B2:G2")) Is Nothing Then
    
    
        If Target.Value <> "" Then
        
            Target.Resize(6).Copy Me.Range("B11")
        End If
    End If


ws_exit:
    Application.EnableEvents = True
End Sub

Change the G2 to your actual last column.

[sivakr68]

Hi Bob

The code should work as below...

B2 get populated it will copy B2:B8 to B11:B18
C2 is Blank, Nothing happens
D2 get populated it will copy D2:D8 to D11:D18
E2 get populated it will copy E2:E8 to E11:E18
F2 is Blank, Nothing happens
G2 is Blank, Nothing happens
H2 get populated it will copy H2:H8 to H11:H18
... and it goes on.

>The columns are independent of each other.
>The cell row 2:8 changes every second/minutes. Sometimes it gets populated, sometimes it is just blank.

The one way I can do it is to follow your first code and just duplicate it for every Column cell. (Please see code below)
However if I have 100 Column, I will have to have 100 IF statements... Unless there is easier way.

Private Sub Worksheet_Change(ByVal Target As Range)




    On Error GoTo ws_exit
    
    Application.EnableEvents = False
    
    If Target.Address = "$B$2" Then
    
    
        If Target.Value <> "" Then
        
            Target.Resize(6).Copy Me.Range("B11")
        End If
    End If


    If Target.Address = "$C$2" Then
    
    
        If Target.Value <> "" Then
        
            Target.Resize(6).Copy Me.Range("C11")
        End If
    End If


    If Target.Address = "$D$2" Then
    
    
        If Target.Value <> "" Then
        
            Target.Resize(6).Copy Me.Range("D11")
        End If
    End If


    If Target.Address = "$E$2" Then
    
    
        If Target.Value <> "" Then
        
            Target.Resize(6).Copy Me.Range("E11")
        End If
    End If


ws_exit:
    Application.EnableEvents = True
End Sub

Thanks

Regards
Siva

[sivakr68]

Hi Bob

Is there any feedback ?

Thanks
Regards

Siva

Hi Bob

The code should work as below...

B2 get populated it will copy B2:B8 to B11:B18
C2 is Blank, Nothing happens
D2 get populated it will copy D28 to D1118
E2 get populated it will copy E2:E8 to E11:E18
F2 is Blank, Nothing happens
G2 is Blank, Nothing happens
H2 get populated it will copy H2:H8 to H11:H18
... and it goes on.

>The columns are independent of each other.
>The cell row 2:8 changes every second/minutes. Sometimes it gets populated, sometimes it is just blank.

The one way I can do it is to follow your first code and just duplicate it for every Column cell. (Please see code below)
However if I have 100 Column, I will have to have 100 IF statements... Unless there is easier way.

Private Sub Worksheet_Change(ByVal Target As Range)




    On Error GoTo ws_exit
    
    Application.EnableEvents = False
    
    If Target.Address = "$B$2" Then
    
    
        If Target.Value <> "" Then
        
            Target.Resize(6).Copy Me.Range("B11")
        End If
    End If


    If Target.Address = "$C$2" Then
    
    
        If Target.Value <> "" Then
        
            Target.Resize(6).Copy Me.Range("C11")
        End If
    End If


    If Target.Address = "$D$2" Then
    
    
        If Target.Value <> "" Then
        
            Target.Resize(6).Copy Me.Range("D11")
        End If
    End If


    If Target.Address = "$E$2" Then
    
    
        If Target.Value <> "" Then
        
            Target.Resize(6).Copy Me.Range("E11")
        End If
    End If


ws_exit:
    Application.EnableEvents = True
End Sub

Thanks

Regards
Siva