VB Function for Copy & Paste

sivakr68

New member
Joined
Mar 9, 2012
Messages
5
Reaction score
0
Points
0
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
 

Attachments

  • SampleData.jpg
    SampleData.jpg
    21.9 KB · Views: 41

Bob Phillips

Super Moderator
Staff member
Joined
Mar 21, 2011
Messages
1,940
Reaction score
0
Points
36
Excel Version(s)
O365
Use this worksheet event code

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

New member
Joined
Mar 9, 2012
Messages
5
Reaction score
0
Points
0
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

Super Moderator
Staff member
Joined
Mar 21, 2011
Messages
1,940
Reaction score
0
Points
36
Excel Version(s)
O365
So, extend it

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, 7).Copy Me.Range("B11")
        End If
    End If

ws_exit:
    Application.EnableEvents = True
End Sub
 

sivakr68

New member
Joined
Mar 9, 2012
Messages
5
Reaction score
0
Points
0
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

Super Moderator
Staff member
Joined
Mar 21, 2011
Messages
1,940
Reaction score
0
Points
36
Excel Version(s)
O365
Is this what you mean

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

New member
Joined
Mar 9, 2012
Messages
5
Reaction score
0
Points
0
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.

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


    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

New member
Joined
Mar 9, 2012
Messages
5
Reaction score
0
Points
0
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 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.

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


    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
 
Top