PDA

View Full Version : Alter code to paste into separate sheet



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

Bob Phillips
12-12-2007, 08:11 AM
MATCH assumes the data is orderedto get a best fit.