Snasui Excel Forum

Code: Select all

Sub Source()

    Dim rSource As Range
    Dim rTarget As Range
    Dim rs As Range
    Dim rt As Range
    
        Set ws1 = Workbooks("Sheet1").Sheets("Sheet1")
        Set ws2 = Workbooks("Sheet1").Sheets("Sheet2")
    
       With ws1
    
        Set rTarget = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
        
        Set rSource = .Range("D2", .Range("D" & Rows.Count).End(xlUp))
        
    End With
    
        
        
    For Each rt In rTarget
            For Each rs In rSource
            
          With ws2
        
                If rt = rs And rs.Offset(0, 1) <> rt.Offset(0, 1) Then
                rt.Offset(0, 6).Value = rt.Offset(0, 0).Value
                rt.Offset(0, 7).Value = rt.Offset(0, 1).Value

            End If
            
          End With
        
        Next rs
        
    Next rt
            
           Set rSource = Nothing
           
           Set rTarget = Nothing
           
       
End Sub

Code: Select all

'Other code
For Each rt In rTarget
    For Each rs In rSource
      With ws2
        If rt = rs And rs.Offset(0, 1) <> rt.Offset(0, 1) Then
            With ws2.Range("a" & .Rows.Count).End(xlUp)
                .Offset(1, 0).Value = rt.Value
                .Offset(1, 1).Value = rt.Offset(0, 1).Value
            End With
        End If
      End With
    Next rs
Next rt
'Other code

Code: Select all

Sub Source()

    Dim rSource As Range
    Dim rTarget As Range
    Dim rs As Range
    Dim rt As Range
    
        Set ws1 = Workbooks("Sheet1").Sheets("Sheet1")
        Set ws2 = Workbooks("Sheet1").Sheets("Sheet2")
    
       With ws1
    
        Set rTarget = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
        
         
    End With
        
        With ws2
        
        Set rSource = .Range("A12", .Range("A" & Rows.Count).End(xlUp))
        
    End With
           
        
    For Each rt In rTarget
    For Each rs In rSource
      With ws2
        If rt <> rs Then
            With ws2.Range("c" & .Rows.Count).End(xlUp)
                .Offset(1, 0).Value = rt.Value
                .Offset(1, 1).Value = rt.Offset(0, 1).Value
            End With
        End If
      End With
    Next rs
Next rt
            
           Set rSource = Nothing
           
           Set rTarget = Nothing
           
       
End Sub

Code: Select all

'Other code
For Each rt In rTarget
    If Application.CountIf(rSource, rt) = 0 Then
        With ws2.Range("c" & ws2.Rows.Count).End(xlUp)
           .Offset(1, 0).Value = rt.Value
           .Offset(1, 1).Value = rt.Offset(0, 1).Value
        End With
    End If
Next rt
'Other code

Code: Select all

Sub Source()

    Dim raLL, r1aLL   As Range
    Dim r, r1 As Range
    Dim rt1, rs1 As Range
    

                With Sheets("Sheet1")
                Set raLL = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
                Set r1aLL = .Range("d2", .Range("d" & Rows.Count).End(xlUp))
            End With
            
            For Each r1 In r1aLL
                
                For Each r In raLL
                
                With Sheets("Sheet1")
                
                    If r1 <> r Then

                    With Sheets("Sheet1").Range("b" & .Rows.Count).End(xlUp)
                            r.Offset(0, 0).Value = r1.Offset(0, 0).Value

                End With
            End If
             Exit For
          End With
        Next r
    Next r1
            
           Set r1aLL = Nothing
           
           Set raLL = Nothing
       
End Sub

Code: Select all

                    With Sheets("Sheet1").Range("b" & .Rows.Count).End(xlUp)
                            r.Offset(0, 0).Value = r1.Offset(0, 0).Value

Code: Select all

Sub Source1()

    Dim rSource As Range
    Dim rTarget As Range
    Dim rs As Range
    Dim rt As Range
    
        Set ws1 = Workbooks("Sheet1").Sheets("Sheet1")
    
       With ws1
    
        Set rTarget = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
        
        Set rSource = .Range("D2", .Range("D" & Rows.Count).End(xlUp))
        
    End With
           
        
        For Each rt In rTarget
            If Application.CountIf(rSource, rt) = 0 Then
                With ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp))
                    .Offset(0, 0).Value = rt.Offset(0, 0).Value
                End With
            End If
        Next rt
            
           Set rSource = Nothing
           
           Set rTarget = Nothing
           
       
End Sub

Code: Select all

With ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp))

Code: Select all

Dim r As Range
With Worksheets("Sheet1")
    For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
        If r.Value <> r.Offset(0, 3).Value Then
            r.Value = r.Offset(0, 3).Value
        End If
    Next r
End With