Help with VBA code

Hey

I need to copy data from sheet E-1 and past it on sheet Overdue.

The data that i need to copy shows have a value between -1 and -1500 and is in column Z. it needs to copy that entire row to sheet Overdue.

I want to create a button so that everyday i can update that data.

The other problem is that i am going to add remarks net to each overdue item and when i update the data everyday the remarks will not correspond to the origanal row. The reason why i am saying this is because items will be added and removed on the overdue schedule on a daily bases

i somehow need a vba code to copy the data to a sheet. and then when i put remarks next to it, it needs to stick to that row so if i delete items or copy the new data of the next day it should still correspond to the previous rows

I hope the one that replies that everything is clear and understanable

Thanks
WesleyM101

Nick's picture

not hugely clear... best is

not hugely clear... best is to add an example sheet clearly showing what you're after.
- login and edit your post

Help

Hi check the blog page i have uploaded an example there

Vishesh's picture

Solution

Paste the following code in a general module and run. See if this is what you want.

Sub CopyOverdues()
    Dim arrSrc
    Dim arrTgt
    Dim rngSrc          As Range
    Dim rngTgt          As Range
    Dim wksSrc          As Worksheet
    Dim wksTgt          As Worksheet
    Dim intRowSrc       As Integer
    Dim intRowTgt       As Integer
    Dim intCols         As Integer
    Dim intMatchCount   As Integer
 
    Set wksSrc = ThisWorkbook.Worksheets("E-1")
    Set wksTgt = ThisWorkbook.Worksheets("Overdue")
    Set rngSrc = wksSrc.Range("A1").CurrentRegion.Resize(, 7)
    Set rngTgt = wksTgt.Range("A1").CurrentRegion
 
    arrSrc = rngSrc
    arrTgt = rngTgt
 
    For intRowSrc = LBound(arrSrc, 1) To UBound(arrSrc, 1)
        If arrSrc(intRowSrc, 7) < 0 Then
            For intRowTgt = LBound(arrTgt, 1) To UBound(arrTgt, 1)
                intMatchCount = 0
                For intCols = 1 To 6
                    If arrSrc(intRowSrc, intCols) = arrTgt(intRowTgt, intCols) Then
                        intMatchCount = intMatchCount + 1
                    End If
                Next intCols
                If intMatchCount = 6 Then
                    Exit For
                End If
            Next intRowTgt
            If intMatchCount <> 6 Then
                If Not Application.ScreenUpdating = False Then Application.ScreenUpdating = False
                rngSrc.Rows(intRowSrc).Copy
                With wksTgt.Range("A1").End(xlDown).Offset(1)
                    .PasteSpecial xlPasteFormats
                    .PasteSpecial xlPasteValues
                End With
                Application.CutCopyMode = False
            End If
        End If
    Next intRowSrc
 
    If Not Application.ScreenUpdating = True Then Application.ScreenUpdating = True
 
    Set rngSrc = Nothing
    Set rngTgt = Nothing
    Set wksSrc = Nothing
    Set wksTgt = Nothing
    On Error Resume Next
    Erase arrSrc
    Erase arrTgt
    On Error GoTo 0
End Sub

vba HELP

Hey

i copied the code you send me into the excel workbook and the it gives the following error when i want to run it

Compile Error

Only Comments May appear after End Sub, end function or end properties

Please help me sort this out

Nick's picture

you must have copied it

you must have copied it incorrectly... try again

hELP

I have done everything from the beginning again. i copied everything that was in the box above.

Now the macro does not want to run anymore

Vishesh's picture

Copy it in a general module.

Copy it in a general module. The code copies only those rows which are not there in overdue sheet and value is <0. In the file that you have attached there is no such record.