View Single Post
 
Old 03-08-2014, 04:34 AM
macropod's Avatar
macropod macropod is offline Windows 7 32bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,963
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

You could add a macro like the following to your 'main' sheet's code module, but you'll need to fix your spelling before the code will work properly.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lRowTgt As Long, lRowDst As Long, i As Long, j As Long
Dim StrDst As String, bFilled As Boolean, bDiff As Boolean, bCol As Boolean
With Target.Worksheet
  ' Find the last row on the input sheet
  lRowTgt = .Range("A" & .Rows.Count).End(xlUp).Row
  ' Check whether we're on the last row
  If Not Intersect(Target, .Range("A" & lRowTgt & ":D" & lRowTgt)) Is Nothing Then
    ' Check whether all cells in columns A:D on the last row are filled in
    bFilled = True
    For i = 1 To 4
      If .Cells(lRowTgt, i).Value = "" Then
        bFilled = False
      End If
    Next
    If bFilled = True Then
    ' All cells in columns A:D on the last row are filled in
      With Target.Worksheet
        ' Find the output sheet
        StrDst = "Customer " & UCase(Trim(.Cells(lRowTgt, 1).Value))
        ' Find the last row on the output sheet
        With Sheets(StrDst)
          lRowDst = .Range("A" & .Rows.Count).End(xlUp).Row
        End With
        ' See if we can find a row on the output sheet that has the same values as the input sheet
        For i = 2 To lRowDst
          bDiff = True
          If .Cells(lRowTgt, 2).Value = Sheets(StrDst).Cells(i, 1).Value And _
            .Cells(lRowTgt, 3).Value = Sheets(StrDst).Cells(i, 2).Value And _
            .Cells(lRowTgt, 4).Value = Sheets(StrDst).Cells(i, 3).Value Then
            bDiff = False: Exit For
          End If
        Next
        If bDiff = True Then
          ' No matches, so copy from the input sheet to the output sheet
          lRowDst = lRowDst + 1
          .Range("B" & lRowTgt & ":D" & lRowTgt).Copy
          With Sheets(StrDst)
            .Paste Destination:=.Range("A" & lRowDst)
          End With
        End If
      End With
    End If
  End If
  ' Find the last row on the input sheet
  lRowTgt = .Range("F" & .Rows.Count).End(xlUp).Row
  ' Check whether we're on the last row
  If Not Intersect(Target, .Range("F" & lRowTgt & ":I" & lRowTgt)) Is Nothing Then
    ' Check whether all cells in columns F:I on the last row are filled in
    bFilled = True
    For i = 6 To 9
      If .Cells(lRowTgt, i).Value = "" Then
        bFilled = False
      End If
    Next
    If bFilled = True Then
    ' All cells in columns F:I on the last row are filled in
      With Target.Worksheet
        ' Find the output sheet
        StrDst = "Customer " & UCase(Trim(.Cells(lRowTgt, 6).Value))
        ' Find the last row on the output sheet
        With Sheets(StrDst)
          lRowDst = .Range("F" & .Rows.Count).End(xlUp).Row
        End With
        ' See if we can find a row on the output sheet that has the same values as the input sheet
        For i = 2 To lRowDst
          bDiff = True
          If .Cells(lRowTgt, 7).Value = Sheets(StrDst).Cells(i, 5).Value And _
            .Cells(lRowTgt, 8).Value = Sheets(StrDst).Cells(i, 6).Value And _
            .Cells(lRowTgt, 9).Value = Sheets(StrDst).Cells(i, 7).Value Then
            bDiff = False: Exit For
          End If
        Next
        If bDiff = True Then
          ' No matches, so copy from the input sheet to the output sheet
          lRowDst = lRowDst + 1
          .Range("G" & lRowTgt & ":I" & lRowTgt).Copy
          With Sheets(StrDst)
            .Paste Destination:=.Range("E" & lRowDst)
          End With
        End If
      End With
    End If
  End If
End With
Application.CutCopyMode = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote