copies blank cell. screws up layout of rows

[hopr37]

2 worksheets
worksheet 1 is for entering data
worksheet 2 makes a copy of certain rows of data from worksheet 1 ( depending if a value was added to a certain row from worksheet 1)

worksheet 1:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Value 1[/TD]
[TD]Value 1[/TD]
[TD]Value 1[/TD]
[/TR]
[TR]
[TD]Blank[/TD]
[TD]Value 2[/TD]
[TD]Value 2[/TD]
[/TR]
[TR]
[TD]Value 3[/TD]
[TD]Value 3[/TD]
[TD]Value 3[/TD]
[/TR]
</tbody>[/TABLE]

So....
Whenever I change a value in the center column, it copies the values of that entire row.
Change value 1 in center column copies first, center and last row to different worksheet. That works great.
Change value 3 in center column copies first,center and last row to a different worksheet just underneath the previous column...that works great.
Now... If I were to change the value in the center column of value 2 AND the first column is blank, it still copies over to a different worksheet. However,
since there is no data in the first row it leaves it blank. The problem is, if I were to change another value in a different center column it moves the entire first row up while leaving the other rows in place thus causing everything to be off . ( Essentially, it would move value 3 up to the blank spot)

Any idea how I can avoid this?

 

[Fluff]

Do you have any data below row 5?

 

[hopr37]

It will fill with data as time goes on.
When I make a change on the first worksheet it copies that information to the second worksheet.
If i change the value again on the first worksheet it again copies the data but places it on the next row down.

Original code:

Sheets("RunningTotal").Range("C5").Offset(r1).Value = Sheets("Copper").Range("A" & Target.Row).Value 'copies column A from "Copper" to C4 of "Running Total"
Sheets("RunningTotal").Range("D5").Offset(r2).Value = Sheets("Copper").Range("D" & Target.Row).Value 'copies column D from "copper" to D4 of "Running Total"
Sheets("RunningTotal").Range("E5").Offset(r3).Value = Sheets("Copper").Range("F" & Target.Row).Value ' copies column F from "copper to column E4 of "Running Total"

 

[Fluff]

I understand that, but should you have any data below that?
If not what is your last row of data?

 

[hopr37]

on the first worksheet I have data going to row 100
on the second worksheet I have no data until I begin entering data on the first worksheet and then it will begin to populate each row and continue populating down one row

 

[Fluff]

Ok, run this

Sub t()
Sheets("RunningTotal").Range("5:1048576").delete
End Sub

it will delete everything on the sheet from row 5 down.
After running it, try the code i supplied in post#4

 

[hopr37]

well, instead of placing the info in row 553 it now put it in row 53

 

[Fluff]

In that case you have something else going on.
Can you post the entire code that you are using?

 

[hopr37]

Sure. But looking at it differently. How about an option that "if any cell between C5 and C100 is blank, put text in the blank cells". That way it would keep everything uniform. The code in question is in red

Private Sub Worksheet_Change(ByVal Target As Range)
'copies the value of colum c into new cell as "old value"
    Dim ColC_Data As Range
    Dim Msg As String
    Dim Ans As Integer


    If Target.Columns.Count > 1 Then
        Exit Sub    'likely row insert or delete operation
    End If


    Set ColC_Data = Range("D4", Range("D" & Rows.Count).End(xlUp))
    If Not Intersect(Target, ColC_Data) Is Nothing Then
        Ans = vbYes
        Application.EnableEvents = False
        If Ans = vbYes Then
            
            'Target.Offset(0, 1).Value = Target.Value    '***********activating this line changes the input value and the previous value the same
            ' *************** activating this line copies old value from input to previous**does not activating "remaining" column
            If Target.Value > 0 Then
            Target.Offset(0, 1).Value = Target.Offset(0, 1).Value - Target.Value    '*****************subtract used from remaining
            End If
        Else
            'Target.Value = Target.Offset(0, 1).Value
        End If
        Application.EnableEvents = True
    End If




'Add Date
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetRow As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("D:D"), Target)
xOffsetRow = 2
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetRow).Value = Now
            Rng.Offset(0, xOffsetRow).NumberFormat = "mm/dd (hh:mm)"
        Else
            Rng.Offset(0, xOffsetRow).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If






[COLOR=#ff0000]'copper running totals[/COLOR]
[COLOR=#ff0000]    On Error Resume Next[/COLOR]
[COLOR=#ff0000]    Application.ScreenUpdating = False[/COLOR]
[COLOR=#ff0000]
[/COLOR]
[COLOR=#ff0000]    If Not Intersect(Target, Range("D:D")) Is Nothing Then[/COLOR]
[COLOR=#ff0000]
[/COLOR]
[COLOR=#ff0000]        Dim r1, r2, r3 As Integer[/COLOR]

[COLOR=#ff0000]        r1 = Application.WorksheetFunction.CountA(Sheets("RunningTotal").Range("C:C")) 'copper column goes to running total sheet,column C[/COLOR]
[COLOR=#ff0000]        r2 = Application.WorksheetFunction.CountA(Sheets("RunningTotal").Range("D:D")) ' used footage column goes to running total sheet,column D[/COLOR]
[COLOR=#ff0000]        r3 = Application.WorksheetFunction.CountA(Sheets("RunningTotal").Range("E:E")) ' date entered column goes to running total sheet, column E[/COLOR]
[COLOR=#ff0000]
[/COLOR]
[COLOR=#ff0000]        Sheets("RunningTotal").Range("C5").Offset(r1).Value = Sheets("Copper").Range("A" & Target.Row).Value 'copies column A from "Copper" to C4 of "Running Total"[/COLOR]
[COLOR=#ff0000]        Sheets("RunningTotal").Range("D5").Offset(r2).Value = Sheets("Copper").Range("D" & Target.Row).Value 'copies column D from "copper" to D4 of "Running Total"[/COLOR]
[COLOR=#ff0000]        Sheets("RunningTotal").Range("E5").Offset(r3).Value = Sheets("Copper").Range("F" & Target.Row).Value ' copies column F from "copper to column E4 of "Running Total"[/COLOR]

    
    End If


    Application.ScreenUpdating = True
    On Error GoTo 0
   




End Sub

 

[Fluff]

Fo you have any code running on the RunningTotal sheet?

 

[hopr37]

no