BENSON
12-12-2007, 07:22 AM
The code posted below is from a previous post in this forum,I would like the results of the macro ( pasting of data based on multiple criteria ) to appear in a seperate worksheet called " Results" starting collum "C" row "5" in the same workbook .Also if an exact match cannot be found , show the results of the nearest match.
Public Sub SimonsJob()
Dim mpRow As Long
Dim mpLastRow As Long
Dim mpFormula As String
Dim mpColumn As Long
Dim mpTarget As Worksheet
With Worksheets("Sheet1")
Set mpTarget = Worksheets(.ComboBox1.Value)
mpLastRow = mpTarget.Cells(Rows.Count, "A").End(xlUp).Row
mpFormula = "MATCH(1,(" & .ComboBox1.Value & "!A1:A" & mpLastRow & "=""" & .ComboBox2.Value & """)*" & _
"(" & .ComboBox1.Value & "!B1:B" & mpLastRow & "=" & .ComboBox3.Value & ")*" & _
"(" & .ComboBox1.Value & "!C1:C" & mpLastRow & "=" & .ComboBox4.Value & "),0)"
On Error Resume Next
mpRow = .Evaluate(mpFormula)
On Error GoTo 0
If mpRow > 0 Then
On Error Resume Next
mpColumn = Application.Match(.Range("b1").Value, Worksheets(.ComboBox1.Value).Rows(1), 0)
On Error GoTo 0
If mpColumn > 0 Then
mpTarget.Cells(mpRow, mpColumn).Value = mpTarget.Cells(mpRow, 1).Value
mpTarget.Cells(mpRow + 1, mpColumn).Value = mpTarget.Cells(mpRow, 2).Value
mpTarget.Cells(mpRow + 2, mpColumn).Value = mpTarget.Cells(mpRow, 3).Value
mpTarget.Cells(mpRow + 3, mpColumn).Value = mpTarget.Cells(mpRow, 4).Value
mpTarget.Cells(mpRow + 4, mpColumn).Value = mpTarget.Cells(mpRow, 5).Value
mpTarget.Cells(mpRow + 5, mpColumn).Value = mpTarget.Cells(mpRow, 6).Value
End If
End If
End With
End Sub
Thanks for any Help
Public Sub SimonsJob()
Dim mpRow As Long
Dim mpLastRow As Long
Dim mpFormula As String
Dim mpColumn As Long
Dim mpTarget As Worksheet
With Worksheets("Sheet1")
Set mpTarget = Worksheets(.ComboBox1.Value)
mpLastRow = mpTarget.Cells(Rows.Count, "A").End(xlUp).Row
mpFormula = "MATCH(1,(" & .ComboBox1.Value & "!A1:A" & mpLastRow & "=""" & .ComboBox2.Value & """)*" & _
"(" & .ComboBox1.Value & "!B1:B" & mpLastRow & "=" & .ComboBox3.Value & ")*" & _
"(" & .ComboBox1.Value & "!C1:C" & mpLastRow & "=" & .ComboBox4.Value & "),0)"
On Error Resume Next
mpRow = .Evaluate(mpFormula)
On Error GoTo 0
If mpRow > 0 Then
On Error Resume Next
mpColumn = Application.Match(.Range("b1").Value, Worksheets(.ComboBox1.Value).Rows(1), 0)
On Error GoTo 0
If mpColumn > 0 Then
mpTarget.Cells(mpRow, mpColumn).Value = mpTarget.Cells(mpRow, 1).Value
mpTarget.Cells(mpRow + 1, mpColumn).Value = mpTarget.Cells(mpRow, 2).Value
mpTarget.Cells(mpRow + 2, mpColumn).Value = mpTarget.Cells(mpRow, 3).Value
mpTarget.Cells(mpRow + 3, mpColumn).Value = mpTarget.Cells(mpRow, 4).Value
mpTarget.Cells(mpRow + 4, mpColumn).Value = mpTarget.Cells(mpRow, 5).Value
mpTarget.Cells(mpRow + 5, mpColumn).Value = mpTarget.Cells(mpRow, 6).Value
End If
End If
End With
End Sub
Thanks for any Help