Mapping Data From Source Sheet, Where Multiple Criteria is Met

[reberryjr]

I'm trying to identify each row in a worksheet, where a certain condition exists, then map information from that row(s), to another worksheet. The below code is giving me a Type Mismatch error at the line in red font. What do I need to correct in this code; or should I be taking a different approach?

Sub IdentifyLatePymts()

Dim ws2, ws3, ws4 As Worksheet
Dim LastRow2 As Long
Dim FindRow As Range
Dim UpdateRow As Long


Set ws2 = ThisWorkbook.Sheets("Management")
Set ws3 = ThisWorkbook.Sheets("Summaries")
Set ws4 = ThisWorkbook.Sheets("Bios")


LastRow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row


ws3.Activate
[COLOR=#ff0000]Set FindRow = ws3.Range("B:B").Find(What:="Active", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) And _[/COLOR]
[COLOR=#ff0000]              ws3.Range("F:F").Find(What:="Late", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)[/COLOR]
                If FindRow Is Nothing Then
                    Exit Sub
                Else
                    UpdateRow = FindRow.Row
                End If


ws2.Range("A" & LastRow2 + 1) = ws3.Range("D" & UpdateRow).Value






End Sub

 

[Coding4Fun]

Try this

This is the data table I used which I had in the sheet "Summaries"

A	B	C	D	E	F	G
	Active		D2		Late
	Fake		D3		No
	Active		D4		No
	No		D5		Late
	Active		D6		Late

<tbody>
</tbody>

After running the code below it would copy "D2" and "D6" and insert that text into the Sheet "Management" in column A of the next available row because they met the criteria of having Active AND Late in Columns B and F.

A	B	C
D2
D6

<tbody>
</tbody>

Sub IdentifyLatePymts()

Dim CheckVal1 As String
Dim CheckVal2 As String


Dim ws2, ws3, ws4 As Worksheet
Dim LastRow2 As Long
Dim FindRow As Range
Dim UpdateRow As Long


Set ws2 = ThisWorkbook.Sheets("Management")
Set ws3 = ThisWorkbook.Sheets("Summaries")
Set ws4 = ThisWorkbook.Sheets("Bios")


ws3.Activate

Temprng = ws3.Range("D" & Rows.Count).End(xlUp).Row


For E = 2 To Temprng
CheckVal1 = Cells(E, "B").Value
CheckVal2 = Cells(E, "F").Value


If CheckVal1 = "Active" And CheckVal2 = "Late" Then
LastRow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
Range(Cells(E, "D"), Cells(E, "D")).Copy Destination:=Sheets("Management").Range("A" & LastRow2)


End If


Next E


End Sub

 

[Osvaldo Palmeiro]

Maybe:

 ...
     Set FindRow = ws3.Range("B:B").Find(What:="Active", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
    
     If Not FindRow Is Nothing And FindRow.Offset(, 4).Value = "Late" Then
      UpdateRow = FindRow.Row
     Else: Exit Sub
     End If
     ...

 

[Coding4Fun]

Maybe:

 ...
     Set FindRow = ws3.Range("B:B").Find(What:="Active", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
    
     If Not FindRow Is Nothing And FindRow.Offset(, 4).Value = "Late" Then
      UpdateRow = FindRow.Row
     Else: Exit Sub
     End If
     ...

Still only will find one result. Need to add a loop in order to find all instances in the sheet where Column B and Column F meet the requirements of having "Active" and "Late". Both your code and the original poster are only going to get the first result. It seems as though you are trying to actually get all instances within the sheet however and for that you need a loop.

I'm trying to identify each row in a worksheet, where a certain condition exists, then map information from that row(s), to another worksheet.

 

[dmt32]

Hi,
untested but try this update to your code

Sub IdentifyLatePymts()
    
    Dim ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
    Dim LastRow2 As Long, UpdateRow As Long
    Dim FindRow As Range
    Dim Search(1 To 2) As String, FirstAddress As String
    
    With ThisWorkbook
        Set ws2 = .Worksheets("Management")
        Set ws3 = .Worksheets("Summaries")
        Set ws4 = .Worksheets("Bios")
    End With
    
    
    LastRow2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row
    
    Search(1) = "Active"
    Search(2) = "Late"
    
    Set FindRow = ws3.Range("B:B").Find(What:=Search(1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
    If Not FindRow Is Nothing Then
        FirstAddress = FindRow.Address
        Do
            If FindRow.Offset(, 4).Value = Search(2) Then
                LastRow2 = LastRow2 + 1
                ws2.Range("A" & LastRow2) = ws3.Range("D" & FindRow.Row).Value
            End If
            Set FindRow = ws3.Range("B:B").FindNext(FindRow)
        Loop While FirstAddress <> FindRow.Address
        
    Else
        
        MsgBox Search(1) & Chr(10) & "Record Not Found", "Not Found"
    End If
    
End Sub

Note also the correction made to your object variable declarations for worksheets.


Dave

 

[reberryjr]

I've been able to get this code to work. Thanks for the responses.

Sub IDLatePymts()

Dim ws, ws2, ws4 As Worksheet
Dim LastRow2, LastRowC As Long
Dim FindRow As Range
Dim TargetRow As Long


Set ws2 = ThisWorkbook.Sheets("Management")
Set ws4 = ThisWorkbook.Sheets("Bios")
LastRow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row


For Each ws In Worksheets
    If Not ws.Name = "Displays" And Not ws.Name = "Management" And Not ws.Name = "Summaries" And Not ws.Name = "Bios" And Not ws.Name = "Stats" _
    And Not ws.Name = "Pymt Tracker" And Not ws.Name = "Financials" And Not ws.Name = "Variables" Then
        LastRowC = ws.Range("CE" & ws.Rows.Count).End(xlUp).Row
        ws.Activate
        If ws.Range("CE" & LastRowC - 1).Value = "Late" Then
            ws2.Range("A" & LastRow2 + 1) = ws.Range("D" & LastRowC - 1).Value
            ws2.Range("B" & LastRow2 + 1) = ws.Range("F" & LastRowC - 1).Value
            ws2.Range("C" & LastRow2 + 1) = ws.Range("CE" & LastRowC - 1).Value
            ws2.Range("D" & LastRow2 + 1) = Format(ws.Range("CD" & LastRowC - 1).Value, "#0.00")
            'ws2.Range ("E" & LastRow1 + 1)
End If
End If


Next ws


End Sub