2 columns in two different sheets transferred to a third column

Question

I am working currently on an Excel-file which consists of 3 sheets. The three sheets consist of following, firstly the sheet "Datenquelle", secondly the sheet "Datenunterschied" and thirdly the sheet "Daten".

All three sheets contain identical column names and similar data. I want to highlight the differences of the data in "Datenquelle" and "Daten" into the sheet "Datenunterschied" via a VBA Macro.

The reference point should be the column "Identifier".

As you can see, the sheet "Daten" contains four datasets with following Identifier numbers:

6257 - 6258 - 6259 - 6260

The sheet "Datenquelle" contains six Identifier numbers:

6257 - 6258 - 6259 - 6260 - 6261 - 6268

The goal would be that all the datasets which are not contained in sheet "Daten", but are contained "Datenquelle", should be taken via a VBA Macro into the sheet "Datenunterschied". In my example, those would be the datasets which following Identifiers "6261" & "6268". The whole cell of the datasets "6261" & "6268" should be transferred to "Datenunterschied".

I tried following Macro, but it didn't produce the right outcome.

Sub Unterschied()
Dim CompareRange As Object, x As Object, y As Object
Dim lastRow As Integer

Set CompareRange = Sheets("Datenquelle").Range("H2:H" & Sheets("Datenquelle").Cells(Rows.Count,  _
9).End(xlUp).Row)

    For Each x In Sheets("Daten").Range("H2:H" & Sheets("Daten").Cells(Rows.Count, 9).End(xlUp). _
Row)
        For Each y In CompareRange

        If y <> x Then
            lastRow = Sheets("Datenunterschied").Cells(Rows.Count, 1).End(xlUp).Row + 1
            Sheets("Datenunterschied").Cells(lastRow, 9).Value = x.Value
            Sheets("Datenunterschied").Cells(lastRow, 10).Value = x.Offset(0, 1).Value
            Sheets("Datenunterschied").Cells(lastRow, 11).Value = x.Offset(0, 2).Value
            Sheets("Datenunterschied").Cells(lastRow, 8).Value = x.Offset(0, -1).Value
            Sheets("Datenunterschied").Cells(lastRow, 7).Value = x.Offset(0, -2).Value
            Sheets("Datenunterschied").Cells(lastRow, 6).Value = x.Offset(0, -3).Value
            Sheets("Datenunterschied").Cells(lastRow, 5).Value = x.Offset(0, -4).Value
            Sheets("Datenunterschied").Cells(lastRow, 4).Value = x.Offset(0, -5).Value
            Sheets("Datenunterschied").Cells(lastRow, 3).Value = x.Offset(0, -6).Value
            Sheets("Datenunterschied").Cells(lastRow, 2).Value = x.Offset(0, -7).Value
            Sheets("Datenunterschied").Cells(lastRow, 1).Value = x.Offset(0, -8).Value
        End If
        Next y
    Next x
End Sub

I have provided the data in here:

https://www.herber.de/bbs/user/137783.xlsm

Greetings Kanime

score 0 · Accepted Answer · answered May 27 '20 at 17:01

Unfortunately your problem is very hard to understand without downloading your excel sheet. I believe I understood what you want, I am going to give you a general answer that you will have to tweak to your personal case. Also I thought about writing code similar to your code but decided to re-write it in a more reusable way. First lets look at how to address different worksheets properly. Check out this topic and this topic. Basically first we want to use Option Explicit. Then we want to declare our workbook and our worksheets as variables and address them in a safe manner.

So our first step:

Option Explicit

Sub Difference()
    Dim wb As Workbook
    Set wb = ThisWorkbook

    Dim ws_data As Worksheet
    Set ws_data = wb.Sheets("Daten")

    Dim ws_dataSource As Worksheet
    Set ws_dataSource = wb.Sheets("Datenquelle")

    Dim ws_dataDiff As Worksheet
    Set ws_dataDiff = wb.Sheets("Datenunterschied")
End Sub

Now you have columns with identifiers in ws_dataSource that cannot be found in ws_data. So we check both sheets for differing identifiers. I will take your approach with declaring ranges where to look for them and then looping through those.

    Dim rSource As Range, rData, rDiff As Range
    Set rSource = ws_dataSource.Range("A1:F1")  'this assumes six columns starting at A1. You will need to adjust the A1:F1 part
    Set rData = ws_data.Range("A1:F1")          'again, your range will vary
    Set rDiff = ws_dataDiff.Range("A1:ZZ1")


    Dim x, y As Range 'these are the cell variables we will use to loop through the ranges. you are using object x and y for this task

    For Each x In rSource
        Dim currentIdentifier As String
        currentIdentifier = x.Value 'value to look for in data range
        Dim foundMatch As Boolean 'setup marker that tells us if no match has been found
        foundMatch = False

        For Each y In rData
            If currentIdentifier = y.Value Then
                foundMatch = True       'this columns needs not to be copied as we have found it in both worksheets
                Exit For
            End If
        Next y

        If Not foundMatch Then          'only when y has been looped through without finding a match
            'here comes the bit where we actually copy the data
            Debug.Print currentIdentifier
        End If
    Next x

I ran out of time for the last bit, but there are plenty of resource where one can learn how to copy and past columns from one sheet to the other. Have a look here: (it comes down to taking a range x and using the copy method. x.copy NewColumn

expression.Copy (Destination)

thank you for your help so far and improving my code. I have adjusted my code accordingly, but when executing the code, nothing happend. I will repost the code, could you please take a second look at it? Because, I don't get, why it does not work. — Kanime Hinyemata, May 28 '20 at 12:20

score 0 · Answer 2 · answered May 28 '20 at 12:21

Option Explicit

Sub Difference()
    Dim wb As Workbook
    Set wb = ThisWorkbook

    Dim ws_data As Worksheet
    Set ws_data = wb.Sheets("Daten")

    Dim ws_dataSource As Worksheet
    Set ws_dataSource = wb.Sheets("Datenquelle")

    Dim ws_dataDiff As Worksheet
    Set ws_dataDiff = wb.Sheets("Datenunterschied")


Dim rSource As Range, rData, rDiff As Range
Dim lastRow As Long

    Set rSource = ws_dataSource.Range("A2:K2") 'this assumes six columns starting at A1. You will need to adjust the A1:F1 part
    Set rData = ws_data.Range("A2:K2")         'again, your range will vary
    Set rDiff = ws_dataDiff.Range("A2:K2")


    Dim x, y As Range 'these are the cell variables we will use to loop through the ranges. you are using object x and y for this task

    For Each x In rSource
        Dim currentIdentifier As String
        currentIdentifier = x.Value 'value to look for in data range
        Dim foundMatch As Boolean 'setup marker that tells us if no match has been found
        foundMatch = False

        For Each y In rData
            If currentIdentifier = y.Value Then
                foundMatch = True       'this columns needs not to be copied as we have found it in both worksheets
                Exit For
            End If
        Next y

        If Not foundMatch Then          'only when y has been looped through without finding a match
            lastRow = Sheets("Datenunterschied").Cells(Rows.Count, 1).End(xlUp).Row + 1
            x.Copy (ws_dataDiff.Range("A2:K2")) 'here comes the bit where we actually copy the data
            Debug.Print currentIdentifier
        End If
    Next x
End Sub

I will take a closer look later, but with `x.copy`you will only copy `x`, which is only one of the identifier cells. You will need to build a range object first, that contains the column of `x` and copy that one. I see you are already finding `lastRow` which means you are almost there (even though you are not looking into the column of x but into column "A"). Just try creating said range and copy that one, then you should have it — MYZ, May 28 '20 at 13:20
I created an object, but the object would then refer to the range - I guess. Can you provide an example of how you mean it, because I still don't get it. — Kanime Hinyemata, May 28 '20 at 14:31
@MertY I wanted to let you know, I found a solution on how to fix my problem. Your code sample helped me to finalize it. I will provide my solution in an answer down. Thank you very much for your help. — Kanime Hinyemata, Jun 02 '20 at 08:08
Hineyamata Great to hear! Sorry that I did not follow up with the last bit, but I am sure you learned more by coming up with your own solution! I am interested to see how you did it in the end :-) — MYZ, Jun 02 '20 at 08:33

score 0 · Answer 3 · answered Jun 02 '20 at 08:12

The solution to the problem looks like following:

Sub Difference()

Dim lastRow As Long
Dim x, y As Object 'Cells which will loop through, but declared as objects.


    For Each x In Sheets("Datenquelle").Range("I2:I" & Sheets("Datenquelle").Cells(Rows.Count, 9).End(xlUp).Row)
        Dim foundMatch As Boolean 'setup marker that tells us if no match has been found
        foundMatch = False

        For Each y In Sheets("Daten").Range("I2:I" & Sheets("Daten").Cells(Rows.Count, 9).End(xlUp).Row)
            If x.Value = y.Value Then
                foundMatch = True       
                Exit For
            End If
        Next y

        If Not foundMatch Then          'only when y has been looped through without finding a match
            lastRow = Sheets("Datenunterschied").Cells(Rows.Count, 9).End(xlUp).Row + 1
            Sheets("Datenunterschied").Cells(lastRow, 9).Value = x.Value ' Copying and setting the data in last available free row
            Debug.Print x.Value
        End If
    Next x
End Sub

2 columns in two different sheets transferred to a third column

3 Answers3