NEED HELP RESCTRUCTURING MACRO TO FIT MY WORK SHEET, PLEASE.

[estatefinds]

This is not my code but is similar in regards to the idea of what I need to work for My worksheet.
I am submitted a file that will show data in Column A, and data in Column J.

I need this macro to be renamed and resctructured so the when the macro is run it will search for the matches in column J to the data in Column A when matched it will carry over the matching fom column J and the data to the left (column I) and right (column K) of the data in Column J to the Columns E F
G.
Im incldung file that shows wha the results should be in column's E,F,G.

If any questions please let me know,please

Thankj you very much in advance!



Sub sAMPLE()
Dim ws As Worksheet
Dim lastRow As Long, i As Long, newRow As Long, rw As Long
Dim aCell As Range, SrchRange As Range


Set ws = Sheets("Sheet1")


With ws
.Columns("A:B").Copy .Columns("G:G")
.Columns("G:H").Sort key1:=.Range("G2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


.Columns("H:H").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove


lastRow = .Range("G" & Rows.Count).End(xlUp).Row


For i = 2 To lastRow
.Range("H" & i).Value = GetLastNumbers(.Range("G" & i).Value)


If .Range("H" & i).Value <> 0 Then
.Range("G" & i).Value = Left(.Range("G" & i).Value, _
Len(.Range("G" & i).Value) - Len(.Range("H" & i).Value))
End If
Next i


.Columns("G:H").Sort key1:=.Range("H2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


For i = 2 To lastRow
If .Range("H" & i).Value <> 0 Then _
.Range("G" & i).Value = .Range("G" & i).Value & .Range("H" & i).Value
Next i


.Columns("H:H").Delete


newRow = lastRow


Set SrchRange = .Range("G2:G" & lastRow)


lastRow = .Range("C" & Rows.Count).End(xlUp).Row


.Range("I1").Value = "NAME": .Range("J1").Value = "QTY"


For i = 2 To lastRow
If Len(Trim(.Range("C" & i).Value)) <> 0 Then
Set aCell = SrchRange.Find(What:=.Range("C" & i).Value, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)


If Not aCell Is Nothing Then
.Range("I" & aCell.Row).Value = .Range("C" & i).Value
.Range("J" & aCell.Row).Value = Application.Evaluate("=SUMPRODUCT((C2:C" & lastRow _
& "=" & """" & .Range("C" & i).Value & """" & ")*(D2:D" & lastRow & "))")
Else
newRow = newRow + 1
.Range("I" & newRow).Value = .Range("C" & i).Value
.Range("J" & newRow).Value = .Range("D" & i).Value
End If
End If
Next
lastRow = .Range("G" & Rows.Count).End(xlUp).Row
For i = lastRow To 2 Step -1
If .Range("G" & i).Value = .Range("G" & i - 1).Value Then
.Range("H" & i - 1).Value = .Range("H" & i).Value + .Range("H" & i - 1).Value
If Application.WorksheetFunction.CountA(.Range("I" & i & ":J" & i)) = 0 Then
.Range("G" & i & ":J" & i).Delete Shift:=xlUp
Else
.Range("G" & i & ":H" & i).Delete Shift:=xlUp
End If
End If
Next i


lastRow = .Range("I" & Rows.Count).End(xlUp).Row
newRow = .Range("G" & Rows.Count).End(xlUp).Row


If lastRow <= newRow Then Exit Sub


.Range("I" & newRow & ":J" & lastRow).Sort key1:=.Range("I" & newRow), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


For i = lastRow To newRow Step -1
If .Range("I" & i).Value = .Range("I" & i - 1).Value Then
.Range("J" & i - 1).Value = .Range("J" & i).Value + .Range("J" & i - 1).Value
.Range("I" & i & ":J" & i).Delete Shift:=xlUp
End If
Next i
End With
End Sub


Function GetLastNumbers(strVal As String) As Long
Dim j As Long, strTemp As String


For j = Len(strVal) To 1 Step -1
If Not IsNumeric(Mid(strVal, j, 1)) Then Exit For
strTemp = Mid(strVal, j, 1) & strTemp
Next j
GetLastNumbers = Val(Trim(strTemp))
End Function

[offthelip]

The code you posted looks horrible and very slow to run, I can't believe it doesn't anything like you have asked for. This code will do what you specified, and it will be really fast.



Sub matchd()With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
' load data in to variant arrays ( this is the fast way to move data around)
cola = Range(.Cells(1, 1), .Cells(lastRow, 1))
datar = Range(.Cells(1, 9), .Cells(lastRow, 11))
'set up output array
Range(.Cells(10, 5), .Cells(lastRow, 7)) = ""
outarr = Range(.Cells(1, 5), .Cells(lastRow, 7))


For i = 10 To lastRow
For j = 10 To lastRow
If cola(i, 1) = datar(j, 2) Then
'copy the row
For k = 1 To 3
outarr(i, k) = datar(j, k)
Next k
Exit For
End If
Next j
Next i
'output the variant array
Range(.Cells(1, 5), .Cells(lastRow, 7)) = outarr


End With


End Sub

[estatefinds]

I worked Great!!!! very efficient!!!! Thank you!!:)

[snb]

In E10

=INDEX($I$10:$I$28;MATCH(A10;$J$10:$J$28;0);1)

In G10

=INDEX($K$10:$K$28;MATCH(A10;$J$10:$J$28;0);1)