Help with code

[VegasNath]

Code: Select all

    j = wb2.Sheets(Format(strDateWork, "dd")).Range("B6").End(xlDown).Row - 1
    Set SrcRng = wb2.Sheets(Format(strDateWork, "dd")).Range("B6:B" & j)
    
    i = wb2.Sheets("Report").Range("A1").End(xlDown).Row
    Set DstRng = wb2.Sheets("Report").Range("A1:A" & i)
    
    'Establish if each cell in SrcRng exists in DstRng, if not exists,
    
    wb2.Sheets("Report").Rows(i).Copy
    Rows(i + 1).Insert Shift:=xlDown 'And rename ("A" & i + 1) with value of SrcRng

I would appreciate some help if possible:

I am trying to compare 2 range's on 2 different sheets and update the report sheet (DstRng) with any new items detailed in the SrcRng. I am somewhat there, but have hit a wall.
For each cell in SrcRng that does not already exist in DstRng, I need to copy the last row of DstRng down one (contains loads of formula in columns B onwards), and update the value in DstRng column A with the value from SrcRng.

[HansV]

You'd need something like this:

Code: Select all

    Dim j As Long
    Dim m As Long
    Dim n As Long
    Dim rngFind As Range
    Dim wsh1 As Worksheet
    Dim wsh2 As Worksheet
    Set wsh1 = wb2.Sheets(Format(strDateWork, "dd"))
    Set wsh2 = wb2.Sheets("Report")
    m = wsh1.Range("B6").End(xlDown).Row - 1
    n = wsh2.Range("A1").End(xlDown).Row
    On Error Resume Next
    For j = 6 To m
        Set rngFind = wsh2.Range("A1:A" & n).Find(What:=wsh1.Range("B" & j), LookIn:=xlValues, LookAt:=xlWhole)
        If Err Then
            wsh2.Rows(n).Copy
            n = n + 1
            wsh2.Rows(n).Insert
            wsh2.Range("A" & n) = wsh1.Range("B" & j)
        End If
    Next j

[VegasNath]

Thanks Hans.

[VegasNath]

The 'If Err Then' was discounting everything, so I changed it to 'If Not Err Then' which appeared to do what I wanted at first glance. However, that is not the case. Now it is adding a new row, even when the row already exists.

[HansV]

Sorry, it was too late last night, I wasn't thinking clearly. Here is is a corrected version:

Code: Select all

    Dim wb2 As Workbook
    Dim j As Long
    Dim m As Long
    Dim n As Long
    Dim rngFind As Range
    Dim wsh1 As Worksheet
    Dim wsh2 As Worksheet
    Set wb2 = ActiveWorkbook
    Set wsh1 = wb2.Sheets(Format(strDateWork, "dd"))
    Set wsh2 = wb2.Sheets("Report")
    m = wsh1.Range("B6").End(xlDown).Row - 1
    n = wsh2.Range("A1").End(xlDown).Row
    For j = 6 To m
        Set rngFind = wsh2.Range("A1:A" & n).Find(What:=wsh1.Range("B" & j), LookIn:=xlValues, LookAt:=xlWhole)
        If rngFind Is Nothing Then
            wsh2.Rows(n).Copy
            n = n + 1
            wsh2.Rows(n).Insert
            wsh2.Range("A" & n) = wsh1.Range("B" & j)
        End If
    Next j

[VegasNath]

Hans, works perfect, Thanks!

One small addition if I may....

I only want to do the find if wsh1.Range("B" & j).Offset(0,5) is not zero. How would I add this?

If wsh1.Range("B" & j).Offset(0,5) <> 0 Then ??

[HansV]

Yes.

[VegasNath]

Before the 'Set' line? Does not work. New rows are not added.

[HansV]

Please post a sample workbook with some dummy data that give a realistic idea of what you're working with.

[VegasNath]

The problem was to do with merged cells in some of the source data, now fixed.

Thanks for your help Hans.

[HansV]

Merged cells

It would indeed have been impossible for me to solve the problem without seeing the workbook...