Solved: Code Deletes headers on .ClearContents
Hi All,
Thanks for helping me out with this spread sheet. It is much appreciated.
How the Counts Sheet Works:
When we enter the a number into the field "Counts B3" the text from the cell "C3" will be copied that number of times into "Vegetable Details".
Current Errors and Problems.
The code almost works perfectly but when refreshing, the code will delete the headers of the sheet "Vegetable Details" unless there is already text in row B4. To see the error occur first delete all text from "Vegetable Details B4" onwards then enter a number in "Counts B3". The Headers will now be cleared and the text will begin at the top of the screen.
How am I able to stop the .ClearContents function from deleting the headers in this instance?
Possibilities: Using an if Statement Stops it from deleting the headers but repeats the entries for each cell instead of just refreashing the data.
[vba]'Code to Copy and paste Vegetable Details
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
With Sheets("Vegetable Details") 'Selects Sheet Vegetables
If c4 <> "" Then .Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp)).ClearContents 'Clears Data for the Given Rows
For Each cel In Sheets("Counts").Range(Cells(3, 1), Cells(Rows.Count, 1).End(xlUp)) 'Selects Text to Copy
If cel.Offset(, 1) <> "" Then
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(cel.Offset(, 1)) = cel
End If
Next
End With
Else
End If
Exits:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub[/vba]
Reply With Quote
