Find row with 2 criteria

[SeppeN]

Is it possible to find a row with 2 criteria? I'm importing survey anwsers to a worksheet, now I want to find the answers of a specified person
I need to find the row in the worksheet(ImportLimesurvey) that has 2 specified cell values:

In that row:

• the value of the C-cell has to be one of the highest value in that column (I used the function

  Application.WorksheetFunction.Max(rng)

  )

This value means how much of the survey is filled in. The highest value stands in multiple answer-rows. The highest value is different for every survey. (example, if a survey has 7 pages and the participant fills in all pages :the highest value is 7 for that person, but if the person didn't complete that survey, the value could be e.g. 3), So the filter of the highest value is if the participant completed the whole survey.

• the value of the L-cell has to be the same as the cell (Worksheets("Dataimport").Range("M2")

M2= accountnumber of the person I need the answers from

The correct row has to be pasted to (Worksheets("Dataimport").Range("A7")

This is my current code:

Dim g As Range
Dim rng As Range
Set rng = Worksheets("ImportLimesurvey").Range("C:C")

d = Application.WorksheetFunction.Max(rng)

With Worksheets("ImportLimesurvey").Range("L:L")
    Set g = .Find(Worksheets("Dataimport").Range("M2"), LookIn:=xlValues)
    g.Activate
End With
e = Range("C" & (ActiveCell.Row))
If e = d Then
ActiveCell.EntireRow.Copy _
Destination:=Worksheets("Dataimport").Range("A7")
End If

The problem here is that he finds the row with the right account number, but the answer with the C-value isn't always the highest. It picks (logically) just the first row with that accountnumber. So how can I find the row that matches those 2 criteria?

Thanks in advance

P.S. I'm new to VBA so I tried to be as specific as possible but if you need any additional info, just ask for it

 

[dmt32]

Hi,
welcome to Forum
If I have understood correctly, You are searching account number in Column L and want to copy the row that has the highest value for it in Column C?

In that case you can update the code to include Range.FindNext to check for the highest value

See if following update to your code does what you want

Sub FindMaxValue()
    Dim FoundCell   As Range, rng As Range
    Dim MaxValue    As Long
    Dim Search      As String, FirstAddress As String
    Dim wsDataImport As Worksheet, wsImportLimesurvey As Worksheet
   
    With ThisWorkbook
        Set wsDataImport = .Worksheets("Dataimport")
        Set wsImportLimesurvey = .Worksheets("ImportLimesurvey")
    End With
   
    Search = wsDataImport.Range("M2").Value
    If Len(Search) = 0 Then Exit Sub
   
    With wsImportLimesurvey
   
        Set FoundCell = .Range("L:L").Find(Search, LookIn:=xlValues, lookat:=xlWhole)
        If Not FoundCell Is Nothing Then
            FirstAddress = FoundCell.Address
            Do
               
                With FoundCell.Offset(, -9)
                    If .Value > MaxValue Then Set rng = FoundCell: MaxValue = .Value
                End With
               
                Set FoundCell = .Range("L:L").FindNext(FoundCell)
                If FoundCell Is Nothing Then Exit Do
            Loop Until FoundCell.Address = FirstAddress
           
            rng.EntireRow.Copy wsDataImport.Range("A7")
            MsgBox Search & Chr(10) & "Record Copied", 64, "Match Found"
           
        Else
            MsgBox Search & Chr(10) & "Record Not Found", 48, "Not Found"
        End If
    End With
End Sub

Solution untested & may need some adjustment but hopefully, goes in right direction for you.

Dave

 

[maabadi]

Test this:

Sub SumForLimit()
Dim g As Range, d As Double, cell As Range
Dim rng As Range, Lr As Long
Set rng = Worksheets("ImportLimesurvey").Range("C:C")
Lr = Cells(Rows.Count, 3).End(xlUp).Row
d = Application.WorksheetFunction.Max(rng)
For Each cell In Worksheets("ImportLimesurvey").Range("L1:L" & Lr)
If cell.Value = Worksheets("ImportLimesurvey").Range("M2").Value And Worksheets("ImportLimesurvey").Cells(cell.Row, 3).Value = d Then
cell.EntireRow.Copy Destination:=Worksheets("Dataimport").Range("A7")
End If
Next cell
End Sub

 

[SeppeN]

Hi,
welcome to Forum
If I have understood correctly, You are searching account number in Column L and want to copy the row that has the highest value for it in Column C?

In that case you can update the code to include Range.FindNext to check for the highest value

See if following update to your code does what you want

Sub FindMaxValue()
    Dim FoundCell   As Range, rng As Range
    Dim MaxValue    As Long
    Dim Search      As String, FirstAddress As String
    Dim wsDataImport As Worksheet, wsImportLimesurvey As Worksheet
  
    With ThisWorkbook
        Set wsDataImport = .Worksheets("Dataimport")
        Set wsImportLimesurvey = .Worksheets("ImportLimesurvey")
    End With
  
    Search = wsDataImport.Range("M2").Value
    If Len(Search) = 0 Then Exit Sub
  
    With wsImportLimesurvey
  
        Set FoundCell = .Range("L:L").Find(Search, LookIn:=xlValues, lookat:=xlWhole)
        If Not FoundCell Is Nothing Then
            FirstAddress = FoundCell.Address
            Do
              
                With FoundCell.Offset(, -9)
                    If .Value > MaxValue Then Set rng = FoundCell: MaxValue = .Value
                End With
              
                Set FoundCell = .Range("L:L").FindNext(FoundCell)
                If FoundCell Is Nothing Then Exit Do
            Loop Until FoundCell.Address = FirstAddress
          
            rng.EntireRow.Copy wsDataImport.Range("A7")
            MsgBox Search & Chr(10) & "Record Copied", 64, "Match Found"
          
        Else
            MsgBox Search & Chr(10) & "Record Not Found", 48, "Not Found"
        End If
    End With
End Sub

Solution untested & may need some adjustment but hopefully, goes in right direction for you.

Dave

Thank you very much Dave.
It does exactly what is has to do.
Thanks a lot!

 

[SeppeN]

Test this:

Sub SumForLimit()
Dim g As Range, d As Double, cell As Range
Dim rng As Range, Lr As Long
Set rng = Worksheets("ImportLimesurvey").Range("C:C")
Lr = Cells(Rows.Count, 3).End(xlUp).Row
d = Application.WorksheetFunction.Max(rng)
For Each cell In Worksheets("ImportLimesurvey").Range("L1:L" & Lr)
If cell.Value = Worksheets("ImportLimesurvey").Range("M2").Value And Worksheets("ImportLimesurvey").Cells(cell.Row, 3).Value = d Then
cell.EntireRow.Copy Destination:=Worksheets("Dataimport").Range("A7")
End If
Next cell
End Sub

Hi maabadi
I ran the code, but it does nothing. I don't get an error message. But also no data is copied or pasted to somewhere...

 

[dmt32]

Thank you very much Dave.
It does exactly what is has to do.
Thanks a lot!

Most welcome glad suggestion helped
We Appreciate the feedback

Dave

 

[SeppeN]

Hello,

The code still works fine on the original excel file but I want to update the file with other codes.
The first version is still in use so i had to copy the file as V2 and now I'm working in V2
Although it uses ThisWorkbook... This code doesn't work anymore in V2.
Can you help me @dmt32 ?

 

[SeppeN]

Hello,

The code still works fine on the original excel file but I want to update the file with other codes.
The first version is still in use so i had to copy the file as V2 and now I'm working in V2
Although it uses ThisWorkbook... This code doesn't work anymore in V2.
Can you help me @dmt32 ?

Nevermind, I found the error. I don't know how to delete this reply so I do it like this.