format on change event

[joemeshuggah]

i received some helpful code that upon change of a cell in one tab, the row
is moved to another tab. is it possible to preserve the formatting of the
row in the move to the next tab? i would think this would be relatively
simple, but cant seem to come close to getting it to happen (the row is 5
columns long, with a thin outline around each cell and wrapped text in the
last column).

if the above is not possible, i thought that this might work (formatting the
row in the new tab after the move has taken place), but im not sure where i
am going wrong.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo stoppit
Application.EnableEvents = False



If Target.Column = 5 And Target.Row > 2 And Target.Value <> "" Then
With Sheets("Account-Specfic Explanations").Cells(Rows.Count,
"A").End(xlUp)
.Offset(1, 0).EntireRow = Target.EntireRow.Value
End With

Target.EntireRow.Delete



With Sheets("Account-Specfic Explanations").Cells(Rows.Count,
"A").End(xlUp).Resize(0, 5).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With Sheets("Account-Specfic Explanations").Cells(Rows.Count,
"A").End(xlUp).Resize(0, 5).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With Sheets("Account-Specfic Explanations").Cells(Rows.Count,
"A").End(xlUp).Resize(0, 5).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With Sheets("Account-Specfic Explanations").Cells(Rows.Count,
"A").End(xlUp).Resize(0, 5).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With Sheets("Account-Specfic Explanations").Cells(Rows.Count,
"A").End(xlUp).Offset(0, 4).WrapText = True
End With

MsgBox Sheets("Account-Specfic Explanations").Cells(Rows.Count,
"A").End(xlUp).Offset(0, 4).Address

End If
stoppit:
Application.EnableEvents = True
End Sub

 

[joemeshuggah]

revised the code as follows; but still cant seem to get the wrapping to work

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo stoppit
Application.EnableEvents = False



If Target.Column = 5 And Target.Row > 2 And Target.Value <> "" Then
With Sheets("Account-Specfic Explanations").Cells(Rows.Count,
"A").End(xlUp)
.Offset(1, 0).EntireRow = Target.EntireRow.Value
End With

Target.EntireRow.Delete

With Sheets("Account-Specfic Explanations").Cells(Rows.Count,
"A").End(xlUp).Resize(1, 5).Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With


With Sheets("Account-Specfic Explanations").Cells(Rows.Count,
"A").End(xlUp).Offset(0, 4).WrapText = True
End With


End If
stoppit:
Application.EnableEvents = True
End Sub

 

[Hakyab]

I think copy-paste is the easiest way to do it: (unmarked lines are my changes)

This is what I used, and would like to hear if an easier way is possible.

Best,

If Target.Column = 5 And Target.Row > 2 And Target.Value <> "" Then
With Sheets("Account-Specfic Explanations").Cells(Rows.Count,
"A").End(xlUp)

Target.EntireRow.Copy
.Offset(1, 0).EntireRow.PasteSpecial xlPasteAll,
PasteSpecialOperationNone

 

[joemeshuggah]

i believe i have solved my dilema (used resize incorrectly)...here is my
revised code


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo stoppit
Application.EnableEvents = False



If Target.Column = 5 And Target.Row > 2 And Target.Value <> "" Then
With Sheets("Account-Specfic Explanations").Cells(Rows.Count,
"A").End(xlUp)
.Offset(1, 0).EntireRow = Target.EntireRow.Value
End With

Target.EntireRow.Delete

With Sheets("Account-Specfic Explanations").Cells(Rows.Count,
"A").End(xlUp).Resize(1, 5).Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With


With Sheets("Account-Specfic Explanations").Cells(Rows.Count,
"A").End(xlUp).Offset(0, 4).WrapText = True
End With


End If
stoppit:
Application.EnableEvents = True
End Sub

 

[Gord Dibben]

I have questions for you at the original thread but I'll ignore that thread
now that you have posted here.

Why have you started a new thread?

Just fragments replies.

Here is some revision of the helpful code that you did not care to attribute
to originator.

Private Sub Worksheet_Change(ByVal target As Excel.Range)
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Me.Range("A1").EntireRow
Set rng2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp) _
.Offset(1, 0)
If target.Address = "$A$1" And target.Value <> "" Then
On Error GoTo stoppit
With Application
.ScreenUpdating = False
.EnableEvents = False
rng1.Copy Destination:=rng2
rng1.Delete
stoppit:
.EnableEvents = True
.ScreenUpdating = True
End With
End If
End Sub


Gord Dibben MS Excel MVP