if cell is contains value then copy row to next free row onto another sheet

[aamarb]

Hi,

I have a multiple tables on multiple sheets that are upadated through a sql query. I then search these sheets for cretain text and copy these rows to a spearate sheet called other tickets using a vba macro.


Sub OtherTickets()
'ActiveSheet.Unprotect
Dim r As Range, c As Range, j As Integer
Dim lngRowPutTo As Long
With Worksheets("OtherTickets")
lngRowPutTo = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
For j = 1 To Worksheets.Count
If Not Worksheets(j).Name = "OtherTickets" Then
With Worksheets(j)
Set r = .Range(.Range("H2"), .Range("H2").End(xlDown))
For Each c In r
If c = "Other Issue" Then
Worksheets("OtherTickets").Range("A" & lngRowPutTo & ":V" & lngRowPutTo).Value = .Range(.Cells(c.Row, "A"), .Cells(c.Row, "V")).Value
lngRowPutTo = lngRowPutTo + 1
End If
If c = "Other Request" Then
Worksheets("OtherTickets").Range("A" & lngRowPutTo & ":V" & lngRowPutTo).Value = .Range(.Cells(c.Row, "A"), .Cells(c.Row, "V")).Value
lngRowPutTo = lngRowPutTo + 1
End If
Next c
End With
End If
Next j
'ActiveSheet.Protect
End Sub

What I would like to do now is for the macro to only append new data to the OtherTickets sheet. All the tables have the same column headers and data in column A1 is unique and is incrementing.

Is there any way I call change the macro to look a the last row on OtherTickets and only copy the data from the other sheets if the value in column A is greater than the value in OtherTickets sheet.

 

[RickXL]

Hi,

Warning: This code has not been executed or tested in any way- bu it looks as if i might be what you ant:

Sub OtherTickets()
    'ActiveSheet.Unprotect
    Dim r As Range, c As Range, j As Integer
    Dim lngRowPutTo As Long
    With Worksheets("OtherTickets")
        lngRowPutTo = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    For j = 1 To Worksheets.Count
        If Not Worksheets(j).Name = "OtherTickets" Then
            With Worksheets(j)
                Set r = .Range(.Range("H2"), .Range("H2").End(xlDown))
                For Each c In r
                    If c = "Other Issue" Then
                        If Worksheets("OtherTickets").Range("A" & lngRowPutTo - 1).Value < .Range("A" & c.Row).Value Then
                            Worksheets("OtherTickets").Range("A" & lngRowPutTo & ":V" & lngRowPutTo).Value = .Range(.Cells(c.Row, "A"), .Cells(c.Row, "V")).Value
                            lngRowPutTo = lngRowPutTo + 1
                        End If
                    End If
                    If c = "Other Request" Then
                        If Worksheets("OtherTickets").Range("A" & lngRowPutTo - 1).Value < .Range("A" & c.Row).Value Then
                            Worksheets("OtherTickets").Range("A" & lngRowPutTo & ":V" & lngRowPutTo).Value = .Range(.Cells(c.Row, "A"), .Cells(c.Row, "V")).Value
                            lngRowPutTo = lngRowPutTo + 1
                        End If
                    End If
                Next c
            End With
        End If
    Next j
    'ActiveSheet.Protect
End Sub

Bascally, it just asks whether the new value is larger than the previous one before copying.