Match data on source and destination sheet and change value

Hi, Cammandk,

maybe you should consider to attach a sample of sheet SCH7 to see which columns you refer to.

A sample for this which may need amendment as I assumed the same Columns for each may look like

Sub EF982445()
Dim rngCell           As Range
Dim wsTarg            As Worksheet
Dim rngFound          As Range

Const cstrCOL_SHEET   As String = "B"
Const cstrCOL_ID      As String = "C"
Const cstrCOL_TYPE    As String = "I"
Const cstrCOL_AMOUNT  As String = "U"
Const cstrCOL_TARG    As String = "AR"

With Sheets("AP")
  On Error Resume Next
  For Each rngCell In .Range("W11", .Range("W" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants, 23)
    If rngCell.Value = "PAID" Then
      Set wsTarg = Sheets(.Cells(rngCell.Row, cstrCOL_SHEET).Value)
      Set rngFound = wsTarg.Cells(1, cstrCOL_ID).EntireColumn.Find(What:=Cells(rngCell.Row, cstrCOL_ID), LookAt:=xlWhole)
      If Not rngFound Is Nothing Then
        If wsTarg.Cells(rngFound.Row, cstrCOL_TYPE).Value = .Cells(rngCell.Row, cstrCOL_TYPE).Value Then
          If wsTarg.Cells(rngFound.Row, cstrCOL_AMOUNT).Value = .Cells(rngCell.Row, cstrCOL_AMOUNT).Value Then
            wsTarg.Cells(rngFound.Row, cstrCOL_TARG).Value = "PAID"
          End If
        End If
      End If
    End If
  Next rngCell
  
  If Err <> 0 Then
    MsgBox "No values to work from found on Sheet '" & .Name & "' in Column W!"
  End If
End With
End Sub

Ciao,
Holger

Hi, DK ,

consider to attach a sample workbook to have a look at. "PAID" from your first post differs "Paid" from your second which might be a reason why the code would skip the lines.

Ciao,
Holger

Hi, Cammandk,

there were some minor blinks with the code but it´s your data on the sheets that gives no matches...

Sub EF982445_2()
Dim rngCell           As Range
Dim wsTarg            As Worksheet
Dim rngFound          As Range

Const cstrCOL_SHEET   As String = "D" '"B"
Const cstrCOL_ID      As String = "E" '"C"
Const cstrCOL_TYPE    As String = "I"
Const cstrCOL_AMOUNT  As String = "U"
Const cstrCOL_TARG    As String = "AR"

Const clngSTART       As Long = 6

With Sheets("AP")
  On Error Resume Next
  For Each rngCell In .Range("W" & clngSTART, .Range("W" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants, 23)
    If rngCell.Value = "PAID" Then
      If Not Evaluate("ISREF('" & .Cells(rngCell.Row, cstrCOL_SHEET).Value & "'!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = .Cells(rngCell.Row, cstrCOL_SHEET).Value
      End If
      Set wsTarg = Sheets(.Cells(rngCell.Row, cstrCOL_SHEET).Value)
      Set rngFound = wsTarg.Cells(1, cstrCOL_ID).EntireColumn.Find(What:=.Cells(rngCell.Row, cstrCOL_ID), LookAt:=xlValue)
      If Not rngFound Is Nothing Then
        If wsTarg.Cells(rngFound.Row, cstrCOL_TYPE).Value = .Cells(rngCell.Row, cstrCOL_TYPE).Value Then
          If wsTarg.Cells(rngFound.Row, cstrCOL_AMOUNT).Value = .Cells(rngCell.Row, cstrCOL_AMOUNT).Value Then
            wsTarg.Cells(rngFound.Row, cstrCOL_TARG).Value = "PAID"
          End If
        End If
      End If
    End If
  Next rngCell
  
  If Err <> 0 Then
    MsgBox "No values to work from found on Sheet '" & .Name & "' in Column W!"
  End If
End With
End Sub

Ciao,
Holger

Hi, Cammandk,

please remember to use code-tags when showing a part of a procedure here on ExcelForum.

This bit will check if the sheet of a given name exists and if not will insert one and give this sheet th ename in order to let the code work smoothly (otherwise a run time error would be raised that the sheet doesn´t exist in the workbook).

Ciao,
Holger

Hi, Cammandk,

I thought that Column I needed to be compared also.

Sub EF982445_3()
Dim rngCell           As Range
Dim wsTarg            As Worksheet
Dim rngFound          As Range

Const cstrCOL_SHEET   As String = "D" '"B"
Const cstrCOL_ID      As String = "E" '"C"
Const cstrCOL_TYPE    As String = "I"
Const cstrCOL_AMOUNT  As String = "U"
Const cstrCOL_TARG    As String = "AR"

Const clngSTART       As Long = 6

With Sheets("AP")
  On Error Resume Next
  For Each rngCell In .Range("W" & clngSTART, .Range("W" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants, 23)
    If rngCell.Value = "PAID" Then
      If Not Evaluate("ISREF('" & .Cells(rngCell.Row, cstrCOL_SHEET).Value & "'!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = .Cells(rngCell.Row, cstrCOL_SHEET).Value
      End If
      Set wsTarg = Sheets(.Cells(rngCell.Row, cstrCOL_SHEET).Value)
      Set rngFound = wsTarg.Cells(1, cstrCOL_ID).EntireColumn.Find(What:=.Cells(rngCell.Row, cstrCOL_ID), LookAt:=xlValue)
      If Not rngFound Is Nothing Then
'        If wsTarg.Cells(rngFound.Row, cstrCOL_TYPE).Value = .Cells(rngCell.Row, cstrCOL_TYPE).Value Then
          If wsTarg.Cells(rngFound.Row, cstrCOL_AMOUNT).Value = .Cells(rngCell.Row, cstrCOL_AMOUNT).Value Then
            wsTarg.Cells(rngFound.Row, cstrCOL_TARG).Value = "PAID"
          End If
'        End If
      End If
    End If
  Next rngCell
  
  If Err <> 0 Then
    MsgBox "No values to work from found on Sheet '" & .Name & "' in Column W!"
  End If
End With
End Sub

Ciao,
HOlger

Hi, Cammandk,

you state that there is another macro copying over - I´m not so sure I´ve seen that before. In Sheet SCH5 Range E12:E24 you use an overcomplicated formula and format the result as text - any reason for that as I think that a normal addiition of the cell before would do as well and any result being displayed as standard would help with a macro. Last: any reason why you copy over the relative number of the record as opposed to copying over the row number directly?

Ciao,
Holger

Hi, David,

I would simplify the sheets as neither the sheetname nor the number need to be placed on these sheets (information may be added when the records are being copied only to AP).

Give this code a try:

Sub EF982445_4()
Dim rngCell           As Range
Dim wsTarg            As Worksheet
Dim rngFound          As Range
Dim rngSearch         As Range
Dim var               As Variant

Const cstrCOL_SHEET   As String = "D" '"B"
Const cstrCOL_ID      As String = "E" '"C"
Const cstrCOL_TYPE    As String = "I"
Const cstrCOL_AMOUNT  As String = "U"
Const cstrCOL_TARG    As String = "AR"

Const clngSTART       As Long = 6

With Sheets("AP")
  Set rngSearch = .Range("W" & clngSTART, .Range("W" & Rows.Count).End(xlUp))
  For Each rngCell In rngSearch
    If rngCell.Value = "PAID" Then
      If Evaluate("ISREF('" & .Cells(rngCell.Row, cstrCOL_SHEET).Value & "'!A1)") Then
        Set wsTarg = Sheets(.Cells(rngCell.Row, cstrCOL_SHEET).Value)
        var = Application.Match(.Cells(rngCell.Row, cstrCOL_ID).Value, wsTarg.Columns(5), 0)
        If Not IsError(var) Then
          If wsTarg.Cells(var, cstrCOL_AMOUNT).Value = .Cells(rngCell.Row, cstrCOL_AMOUNT).Value Then
            wsTarg.Cells(var, cstrCOL_TARG).Value = "PAID"
          End If
        End If
      End If
    End If
  Next rngCell
  
  If Err <> 0 Then
    MsgBox "No values to work from found on Sheet '" & .Name & "' in Column W!"
  End If
End With
End Sub

Ciao,
Holger

Hi, David,

as long as the date is always entered as a constant (not as a Formula) the basics can be kept only the logic needs to be changed (from a check of rngCell.Value being "PAID" to a check if IsDate(rngCell.Value)). When copying over you might need to format the cell value accordingly because otherwise the sequentiel number of the day would be placed.

Sub EF982445_5()
Dim rngCell           As Range
Dim wsTarg            As Worksheet
Dim rngFound          As Range
Dim rngSearch         As Range
Dim var               As Variant

Const cstrCOL_SHEET   As String = "D" '"B"
Const cstrCOL_ID      As String = "E" '"C"
Const cstrCOL_TYPE    As String = "I"
Const cstrCOL_AMOUNT  As String = "U"
Const cstrCOL_TARG    As String = "AR"

Const clngSTART       As Long = 6

With Sheets("AP")
  Set rngSearch = .Range("W" & clngSTART, .Range("W" & Rows.Count).End(xlUp))
  For Each rngCell In rngSearch
    If IsDate(rngCell.Value) Then
      If Evaluate("ISREF('" & .Cells(rngCell.Row, cstrCOL_SHEET).Value & "'!A1)") Then
        Set wsTarg = Sheets(.Cells(rngCell.Row, cstrCOL_SHEET).Value)
        var = Application.Match(.Cells(rngCell.Row, cstrCOL_ID).Value, wsTarg.Columns(5), 0)
        If Not IsError(var) Then
          If wsTarg.Cells(var, cstrCOL_AMOUNT).Value = .Cells(rngCell.Row, cstrCOL_AMOUNT).Value Then
            wsTarg.Cells(var, cstrCOL_TARG).Value = Format(rngCell.Value, "DD.MM.YYYY")
          End If
        End If
      End If
    End If
  Next rngCell
  
  If Err <> 0 Then
    MsgBox "No values to work from found on Sheet '" & .Name & "' in Column W!"
  End If
End With
End Sub

I´d go away and use an unique identifier for each record in any sheet and use that. With what you have right now you would need to loop through the range of visible cells and copy each row over separately in order to get the row number.

Ciao,
Holger