Overwrite data once certain value is reached

[Seeno]

Hi All,

I have some code which takes some data and then matches it to a specific column and then inputs that data on the next available row.

What I want to happen is that when the data gets to 8 rows, I would like it go back to the first row in that column and overwrite the data back to the 8 rows and then start again.

Here is the code I have so far:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("A2")) Is Nothing Then CopyRng
End Sub

Sub CopyRng()
Dim WS1 As Worksheet
Dim Rng As Range
Dim Col As Long
On Error Resume Next 'Without this macro crashes if there's no match
Set WS3 = Sheets("Sheet3")

Set Rng = WS3.Range("A6") 'column header

With WS3
'Finds the column to copy:
Col = Application.WorksheetFunction.Match(WS3.Range("A6").Value, .Rows("1:1"), False)

'Writes the values to the last empty cell from the bottom of the column:
.Cells(.Rows.Count, Col).End(xlUp).Offset(1, 0).Resize(Rng.Rows.Count).Value = Range("A2").Value

End With
End Sub

So this does what I want but instead of finding the next available row in that column, I would like to determine if there are already 8 lines of data and if there are overwrite the old data in line 1 and then continue.

Thanks
Matt

P.S I can't find how to add the code in the excel format like other posts

 

[wideboydixon]

Largely using your existing code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Target.Worksheet.Range("A2")) Is Nothing Then CopyRng

End Sub
Sub CopyRng()

Dim WS3 As Worksheet
Dim Rng As Range
Dim Col As Variant
Dim Rw As Long

Set WS3 = Sheets("Sheet3")
Set Rng = WS3.Range("A6") 'column header

With WS3
    'Finds the column to copy:
    Col = Application.Match(.Range("A6").Value, .Rows("1:1"), False)
    If Not IsError(Col) Then
        Rw = .Cells(.Rows.Count, Col).End(xlUp).Row
        If Rw = 9 Then
            .Range(.Cells(2, Col), .Cells(9, Col)).ClearContents
            Rw = 1
        End If
        
        'Writes the values to the last empty cell from the bottom of the column:
        .Cells(Rw + 1, Col).Value = .Range("A2").Value
    End If
End With

End Sub

BTW, you can use code tags to post code.

WBD

 

[JackDanIce]

Hi Matt, try:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Cells(2, 1)) Is Nothing Then CopyRng

End Sub


Sub CopyRng()

    Dim wks As Worksheet
    Dim rng As Range
    Dim y   As Long
    
    On Error Resume Next
    Set wks = Sheets("Sheet3")
    If wks Is Nothing Then Exit Sub
    On Error GoTo 0
    
    Application.ScreenUpdating = False
    
    With ws
        y = .Cells(1, .Columns.count).End(xlToLeft).column
        Set rng = .Cells(1, 1).Resize(, y).find(what:=.Cells(6, 1).Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not rng Is Nothing Then
            x = .Cells(.Rows.count, rng.column).End(xlUp).row + 1
            Set rng = .Cells(x, rng.column)
            rng.Value = .Cells(2, 1).Value
            If x = 10 Then
                With .Cells(2, rng.column)
                    .Resize(9).ClearContents
                    .Value = .Cells(2, 1).Value
                End With
                Set rng = Nothing
            End If
        End If
    End With
    
    Application.ScreenUpdating = True
    
    Set wks = Nothing
    
End Sub

 

[Seeno]

Hi Guys,

Thanks for your response great help.

Both of these work to a certain extent but they don't do exactly what I want, maybe I didn't explain myself well enough.

WBD - Your code works as it overwrites the first value when the row gets to 9, but after that it keeps on submitting the next data in row 10, row 11 etc rather than overwriting the second row, third row etc.

JackDan - I get to the recommended row and then your code overwrites the second line, and then when data comes in it just keeps overwriting the second line, rather than moving on.

I want to overwrite the previous data and then keep overwriting, until 8 values reached then repeat.

I thank you for taking the time to do that bit and it my help me to try and find the answer, if it is possible.

Thanks
Matt

 

[JackDanIce]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Cells(2, 1)) Is Nothing Then CopyRng

End Sub

Sub CopyRng()

    Dim wks As Worksheet
    Dim rng As Range
    Dim y   As Long
    
    On Error Resume Next
    Set wks = Sheets("Sheet3")
    If wks Is Nothing Then Exit Sub
    On Error GoTo 0
    
    Application.ScreenUpdating = False
    
    With ws
        y = .Cells(1, .Columns.count).End(xlToLeft).column
        Set rng = .Cells(1, 1).Resize(, y).find(what:=.Cells(6, 1).Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not rng Is Nothing Then
            x = .Cells(.Rows.count, rng.column).End(xlUp).row + 1
            Set rng = .Cells(x, rng.column)
            rng.Value = .Cells(2, 1).Value
            If x > 9 Then
                .Cells(2, rng.column).Resize(x).ClearContents
                .Value = .Cells(2, 1).Value
                Set rng = Nothing
            End If
        End If
    End With
    
    Application.ScreenUpdating = True
    
    Set wks = Nothing
        
End Sub

 

[Seeno]

Hi JD,

This still just keeps populating into the next empty row.

Do you think it would be better if I put some test in all of the rows and then I could get rid of find next empty row ?

Not sure how excel would know which cell to paste in though once they were full, I would have to put some sort of test/if statement in there.

Thanks for your help

Matt

 

[JackDanIce]

My code assumes you start with no data in C2:C9

 

[Seeno]

There won't be data in any of the columns.

What I am trying to do is capture a user log. So I have a number of products lets 1 2 3 4 5 which will have certain amount with them and if person x takes 10kg of product 5 I want it to capture that and populate the corresponding column.

However, because there will be numerous people taking numerous amounts I don't want it to populate down infinitely, I am only interested in the last 5 transactions. So that's all I really need to record, so I would rather just overwrite on existing cells rather than populating down to row 1000 for each product.

Thanks again.

Matt

 

[JackDanIce]

Try the code with data populated in C2:C9, your original post suggests there is already data there since you wanted a maximum of 8 before starting again. Also try it for 20 entries/runs.

 

[Seeno]

Fixed that it was just a typo as it was 'with ws rather than with wks'.

Now I get method or data member not found with the .value highlighted in:

.Value = .Cells(2, 1).Value

Thanks
Matt