Hi,

I already posted on message about a year ago on the same topic:
see url:
https://groups.google.com/forum/?hl=...I/pPHGA4KWHy0J

At that time of the thread in the link, I was learning from basic level Vba for Excel. Since them, I think I improved and as a matter of fact, I want to see if what I have done is ok. Please read the instruction below as a few things have changed from the original post in the link (colums have also to be taken into consideration):

explanation ---o---

I have a task that I can achieve up to one point using vlookup but afterwards I need to manually add rows or columns to update the data with a new set of data. Nothing should be deleted from the data in the first set. Even if one row is empty from the first set is not present in the second set of data, it should remain as an empty data row (but still with its identifier).

For example:

1st set:
col1 col2 col5 col6
A data 1
B
C
F

2nd set:
col1 col2 col6 col7
A data 2 (row C and col5 are missing)
B
D
E
F

should result in

col1 col2 col5 col6 col7
A data 2 only (merger)
B
C
D
E
F

In the result, C is an empty row as it's not in the second set but must still be present with the letter C but without any data

Col5 will be empty as well as it's only present in the first set.

Please find my code for this, I have to say it's far from working with large amount of data as I don't use extensively objects methods. If someone could show how this could be simplified, that's the purpose of my post, otherwise the code works properly (I only have 50 to 100 lines so I'm not looking for performance...however I would like to see a code that takes in consideration performance)

Thanks

---o---
my code
---o---

Sub A_IncorpNewRC4()

Dim wb As Workbook
Dim wsActif As Worksheet
Dim wsActif2 As Worksheet
Dim wsActifResult As Worksheet
Dim wsR As Worksheet

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayAlerts = False
End With

Set wb = ThisWorkbook
Set wsActif = wb.Worksheets("ActifJuin")
Set wsActif2 = wb.Worksheets("ActifJuil")
Set wsR = wb.Worksheets("Sheet3")
Set wsActifResult = wb.Worksheets("RESULTAT1")

wsActif.Rows(1).Copy wsActifResult.Range("A1")

'Range sort before array affect
SortRange2 wsActif
SortRange2 wsActif2

RetRowNbFor wsActif, wsActif2, wsActifResult

wsR.Select
wsActifResult.Range("A2:B24").Copy wsR.Cells(2, 6)

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayAlerts = True
End With

Set wb = Nothing
Set wsActif = Nothing
Set wsActif2 = Nothing

End Sub

Sub RetRowNbFor(ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet)

Dim wb As Workbook
Dim wsZ As Worksheet
Set wb = ThisWorkbook
Set wsZ = wb.Worksheets("Sheet3")
Dim rM As Range

Dim lastr1 As Long, lastr2 As Long
Dim lastr3 As Long
Dim lastc1 As Long, lastc2 As Long
Dim lastr1b As Long, lastr2b As Long

Dim i As Long, j As Long, k As Long
Dim z As Long

Dim boo As Long
Dim Vjuin As Long, Vjuill As Long
Dim VjuinB As Long, VjuillB As Long
Dim Fjuill As Long
Dim bplus As Long, bmoins As Long
Dim r As Range

boo = 0
lastr1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
lastc1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
lastr2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
lastc2 = ws2.Cells(1, Columns.Count).End(xlToLeft).Column
k = 2

boo = 0
For i = lastr1 To 2 Step -1
boo = 0
If IsEmpty(ws1.Cells(i, 1).Value) = False Then

Vjuin = ws1.Cells(i, 1).Value

For j = lastr2 To 2 Step -1

If IsEmpty(ws2.Cells(j, 1).Value) = False Then

Vjuill = ws2.Cells(j, 1).Value

If Vjuill < Vjuin Then
boo = 3
ElseIf Vjuill = Vjuin Then
boo = 2
Exit For
Else
boo = 0
End If

End If

Next j

If boo = 3 Then
ws3.Cells(k, 1).Value = Vjuin
ws3.Rows(k).Insert
ElseIf boo = 2 Then
Set rM = ws2.Range(ws2.Cells(j, 1), ws2.Cells(j, lastc2))
rM.Copy ws3.Cells(k, 1)
ws3.Rows(k).Insert
End If

End If

Next i


For i = lastr2 To 2 Step -1
boo = 0
If IsEmpty(ws2.Cells(i, 1).Value) = False Then

Vjuill = ws2.Cells(i, 1).Value

For j = lastr1 To 2 Step -1
boo = 0
If IsEmpty(ws1.Cells(j, 1).Value) = False Then

Vjuin = ws1.Cells(j, 1).Value

If Vjuin < Vjuill Then
boo = 1
Else
Exit For
End If

End If

Next j

If boo = 1 Then

lastr3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row

For j = lastr3 To 2 Step -1

Fjuill = ws3.Cells(j, 1).Value

If IsEmpty(ws3.Cells(j + 1, 1)) = False Then
bplus = ws3.Cells(j + 1, 1).Value
Else
bplus = 999999
End If
If j = 2 Then
bmoins = 0
Else
bmoins = ws3.Cells(j - 1, 1).Value
End If

If Vjuill < bplus And Vjuill bmoins Then

Set rM = ws2.Range(ws2.Cells(i, 1), ws2.Cells(i, lastc2))
ws3.Rows(j).Insert
rM.Copy ws3.Cells(j, 1)

Exit For
End If

Next j

End If
End If
Next i

ws3.Rows(2).Delete

End Sub


Sub SortRange2(ws As Worksheet)

Dim lastr As Long
Dim lastc As Long

lastr = ws.Cells(Rows.Count, 1).End(xlUp).Row
lastc = ws.Cells(1, Columns.Count).End(xlToLeft).Column

Dim r As Range
Set r = ws.Range(ws.Cells(1, 1), ws.Cells(lastr, lastc))

r.Sort key1:=ws.Columns(1), Header:=xlYes

End Sub


---o---end code

If you feel you can help by providing a code of your own, likely shorter since there might be methods that would spare me a couple of lines from above..

Pascal Baro