Matching failed

[TheAnswer]

Dim aFound As Range, bFound As Range, cFound As Range

With Sheets("Vol")

Set aFound = .Rows(10).Find(What:="Agency & Custodian", After:=.Rows(10).Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)

Set cFound = .Columns("C").Find(What:="Credit Reviews", _
After:=.Columns("C").Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)


Set bFound = .Rows(9).Find(What:="10/2010", After:=.Rows(9).Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)


End With

a = Index("Volume Reports", Match("bFound", 0), Match("cFound", 0))
a.Copy

I have error for the coding which is on bold. Appreciate all helps.

[p45cal]

Untested, but try:Dim aFound As Range, bFound As Range, cFound As Range, a As Range
With Sheets("Vol")
Set aFound = .Rows(10).Find(What:="Agency & Custodian", After:=.Rows(10).Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Set cFound = .Columns("C").Find(What:="Credit Reviews", After:=.Columns("C").Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Set bFound = .Rows(9).Find(What:="10/2010", After:=.Rows(9).Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
End With
Set a = Intersect(cFound.EntireRow, bFound.EntireColumn)
a.Copy

[TheAnswer]

Omg, thanks a lot, it works!!!
haha, but i will like to move "a" two rows below before it is copied. From cell "AF13" to "AF15".
Is it possible?

[p45cal]

"move" needs clarifying. What would you do to the cell and/or its contents if you were doing this manually? Copy/Paste? Click and Drag? Copy/PasteSpecial? Just Copy? etc.

[TheAnswer]

i cannot do copy and paste cells cause the format will change thus the data copied over to the other workbook will be different each time the cells changed.

[TheAnswer]

These are the two samples that i had uploaded. I wish to copy the values of "received","processed" and "completed" over to another worksheet. I cannot do simply by copying and pasting the cells as the format of sample 1 will keep on changing.

[p45cal]

With the likes ofSub Macro2()
Workbooks("sample1.xls").Sheets("Sheet1").Range("E6:H8").Copy
Workbooks("sample2.xls").Sheets("Sheet1").Range("C23").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End SuborSub Macro3()
Set Source = Workbooks("sample1.xls").Sheets("Sheet1").Range("E6:H8")
Workbooks("sample2.xls").Sheets("Sheet1").Range("C23").Resize(Source.Rows.Count, Source.Columns.Count).Value = Source.Value
End Sub

[kroz]

With the likes ofSub Macro2()
Workbooks("sample1.xls").Sheets("Sheet1").Range("E6:H8").Copy
Workbooks("sample2.xls").Sheets("Sheet1").Range("C23").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
or you can do this:


Sub Macro2()
Workbooks("sample1.xls").Sheets("Sheet1").Range("E6:H8").Copy destination:= Workbooks("sample2.xls").Sheets("Sheet1").Range("C23").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Application.CutCopyMode = False
End Sub



It's exactly the same code only i've changed the shape a little.

[TheAnswer]

Thanks. But there is another problem. I will like to use If, else statement to loop through both workbooks and if it find a match between column B of "2.xls" and column A:B of "1.xls" then it will loop through column D of "2.xls" and if it matches column B of "1.xls" then it will copy the values of "received","processed" and "completed" onto "1.xls"

[TheAnswer]

This is "2.xls"

[kroz]

Not tested - i didn't really understand what you wanted to copy but it should get you close to your goal:


Sub newff()
Dim oneCell As Range
Dim rRow As Integer, DRow As Integer
Workbooks("2.xls").Activate
rRow = Range("B2").SpecialCells(xlLastCell)
For Each oneCell In Range("B1:B" & rRow).Cells
oneCell.Value = Application.VLookup(oneCell.Value, Workbooks("1.xls").Worksheets("Sheet1").Range("A:B"), 2, 0)
If Not (IsError(oneCell.Value)) Then
DRow = Application.WorksheetFunction.Match(oneCell.Value, Range("D:D"), 0)
If DRow > 0 Then 'it matched the B cell with the D one on row DRow
Workbooks("2.xls").Worksheets("Sheet1").Range(YourRange2).Copy Destination:=Workbooks("1.xls").Worksheets("Sheet1").Range(YourRange1)
Application.CutCopyMode False
End If
end if
Next
End Sub

[TheAnswer]

DRow = Application.WorksheetFunction.Match(oneCell.Value, Range("D:D"), 0)


Thanks for the help but i received error for this sentence. It is unable to get match property of the worksheet function class.

[kroz]

this should work better, i modified it a bit:

Sub newff()
Dim oneCell As Range
Dim rRow As Integer, DRow As Integer
Workbooks("2.xls").Activate
rRow = Range("B65536").End(xlUp).Row
For Each oneCell In Range("B1:B" & rRow).Cells
oneCell.Value = Application.VLookup(oneCell.Value, Workbooks("1.xls").Worksheets("Sheet1").Range("A:B"), 2, 0)
If Not (IsError(oneCell.Value)) Then
If Not (IsError(Application.Match(oneCell.Value, Range("D:D"), 0))) Then 'it matched the B cell with the D one on row DRow
DRow = Application.Match(oneCell.Value, Range("D:D"), 0)
Workbooks("2.xls").Worksheets("Sheet1").Range("A:A").Copy Destination:=Workbooks("1.xls").Worksheets("Sheet1").Range("D1")
End If
End If
Next
End Sub


Replace the copied ranges with the ones you need

[kroz]

hm, there was a slight error in my code. I noticed i made it to replace instead of just using the value. The fixed code


Sub newff()
Dim oneCell As Range
Dim rRow As Integer, DRow As Integer
dim aTemp as String
Workbooks("2.xls").Activate
rRow = Range("B65536").End(xlUp).Row
For Each oneCell In Range("B1:B" & rRow).Cells
aTemp = Application.VLookup(oneCell.Value, Workbooks("1.xls").Worksheets("Sheet1").Range("A:B"), 2, 0)
If Not (IsError(aTemp)) Then
If Not (IsError(Application.Match(aTemp, Range("D:D"), 0))) Then 'it matched the B cell with the D one on row DRow
DRow = Application.Match(aTemp, Range("D:D"), 0)
Workbooks("2.xls").Worksheets("Sheet1").Range("A:A").Copy Destination:=Workbooks("1.xls").Worksheets("Sheet1").Range("D1")
End If
End If
Next
End Sub

[TheAnswer]

Hi, there is error with the statement below.

Error: Type Mismatch



aTemp = Application.VLookup(oneCell.value, Workbooks("1.xls").Worksheets("Sheet1").Range("A:B"), 2, 0)

[kroz]

you are right, change

Dim aTemp as String

to

Dim aTemp as Variant

[TheAnswer]

Thanks but there is still error. Runtime error 9.
Subscript out of range.

[kroz]

Did you modify the ranges to fit your needs?


Workbooks("2.xls").Worksheets("Sheet1").Range("A:A").Copy Destination:= _
Workbooks("1.xls").Worksheets("Sheet1").Range("D1")


I didn't really understand how you want to copy the info, i didn't find anything related in your files.

[TheAnswer]

Ya, i did change the values to meet my needs and the error is found at this sentence :
aTemp = Application.VLookup(oneCell.Value, Workbooks("1.xls").Worksheets("Sheet1").Range("A:B"), 2, 0)

Example 1 from "2.xls":
08/200809/2008
Deposit Placement/ RolloverBBCA CollateralReceived.1Processed..Completed..
Example 2 from "1.xls":
AugSep
6. Deposit Placement/ Rolloveri. Project AccountReceived 45 26 38 26 30 Processed 45 26 38 26 30 Completed 45 26 38 26 30 Total Completed 45 26 38 26 30


Is it possible use look through the first column and if "Deposit Placement/rollover" of "2.xls" matches with "Deposit Placement/Rollover" of "1.xls". Then it will look through "received,processed and completed" and if two worksheets matches then values from "2.xls" will be copied over to "1.xls".

Thanks a lot for your help.

[TheAnswer]

Oh no!! My bad..
I sent you the wrong file
Please refer to this new attached file instead of "1.xls"
So sorry for the problem caused.