Lookup macro

[shenoy]

Hi all,
I am a newbee to VBA as well as to this forum. can anybody please help me with this problem.
I have two spreadsheets with lets say 10 columns each. there are around 3000 rows in the first spreadsheet and around 4000 in the second sheet. lets call them book A and book B
The first column in the both books contains microfilm numbers and is unique for every record.. Book A has another column called ORC number which is also a unique for every record.
Book B has only the microfilm number common with book A, and rest of the data totally is different. Another thing is, Book B might contain more than one occurance (or omission) of the microfilm number and contains no ORC number.
Now my task is to replace the microfilm number in book B with the ORC numbers from Book A by comparing the two microfim numbers. This is pretty easy doing it manually with lookups but since this is a repitative task i am writing a code.. the code works fine but is very slow. Maybe i did not use the right lingo.. can somebody help me please..
for simplicity's sake i have said book A and book B but actually I have to work with 12 different such books.
Any help is appreciated. thanks!

My code
Sms01000 is the book A
Assuming i am in book B,

Range("N1").Select
ActiveCell.FormulaR1C1 = "=LOOKUP(RC[-13],sms01000.txt!C1,sms01000.txt!C23)"
Application.Calculation = xlCalculationAutomatic
Range("N1").Select
Set AutoFillRg = Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, -1).End(xlDown))
Selection.AutoFill Destination:=Range(ActiveCell.Address, AutoFillRg.Offset(0, 1).Address)
Columns("N:N").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("N:N").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Cells.Select
Cells.EntireColumn.AutoFit

 

[tactps]

Without changing your methof, this should speed it up a bit:

1. You are recalculating multiple times. Change:
Application.Calculation = xlCalculationAutomatic
to
Application.Calculation = xlCalculationManual
and at the end:
Calculate
Application.Calculation = xlCalculationAutomatic

2. You are wasting time refreshing your screen continually. At the start:
application.screenupdating = false
and at the end:
application.screenupdating = true

Let me know how that goes.

 

[shenoy]

Hi,
I tried to do that but since calculation is on manual it is copying the value of ORC number in the first cell instead of the copying the lookup formula.
is there another way..? Thanks for responding so quickly...

 

[tactps]

How about this (replacing the whole macro - untested):

sub trythis()
application.screenupdating = false
range("a1").select
do until activecell.text = ""
LookupRef = range("a1").value
ActiveCell.FormulaR1C1 = "=LOOKUP(" & LookupRef & ",sms01000.txt!C1,sms01000.txt!C23)"
activecell.value = activecell.formula
activecell.offset(1,0).select
loop
application.screenupdating = true
end sub

 

[Legacy 12630]

It's unlikely that code that uses a loop is going to be quicker than code that avoids looping by using native XL worksheet functions.

It is not necessary to loop or copy/paste a formula to fill a range. For example :-

[A1:A10].FormulaR1C1 = "=IF(RC[1]>2,RC[2]-1,R[3]C[3]+1)"

fills A1:A10. The syntax for whatever formula is required can be obtained from the macro recorder.

Have a look at "=LOOKUP(RC[-13],sms01000.txt!C1,sms01000.txt!C23)" Try generating the syntax for this code via the macro recorder, and then try revising your macro to :-

Range([N1], [M1].End(xlDown)(1, 2)).FormulaR1C1 = "=your lookup formula obtained via macro recorder"
Columns("A:A") = Columns("N:N").Value
Columns("N:N").Delete
Cells.Columns.AutoFit

 

[shenoy]

@tactps
Its not working, The every cell gets replaced by the text
=LOOKUP(12361785,sms01000.txt!C1,sms01000.txt!C23) Same text for all rows in col A, even the lookupref did not change
I changed the format to general and it returned #NA#

@pasonby,
I tried your way and the Macro took a lot longer time..actually it hung on the sixth file. had to do the three finger salute "ctrl alt del" to terminate ( i had mentioned that i have around 12 files to work with)

any solutions?

Thanks

 

[Legacy 12630]

@pasonby,
I tried your way and the Macro took a lot longer time..actually it hung on the sixth file. had to do the three finger salute "ctrl alt del" to terminate ( i had mentioned that i have around 12 files to work with)

any solutions?

Thanks

@sehnay
Post the complete code you tried. At the moment it's a bit like trying to write a letter while blindfolded.

 

[shenoy]

Ponsonby,
here is the code. i have truncated some repetitive parts in the end as indicated.. I know this is not a very optimized way of writing the code, since i have no formal training with computers i just dont know how to write it efficiently.

Sub Macro1()
'
'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Workbooks.OpenText Filename:="C:\temp\2004 acc\DATA\sms01000.txt", DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15, 2), Array(16, 2), Array(17, 2), Array(18, 2), Array(19, 2), Array(20, 2), Array(21, 2), Array(22, 2), Array(23, 2), Array(24, 2))
Cells.Select
Selection.ColumnWidth = 8.57
Cells.EntireColumn.AutoFit

'opens the text file in excel comma delimited and i have set the format to be text because i dont want to change some date formats. the date format in the original file is yyyy-dd-mm. another advantage is that some numbers starting with 0 like 0765 are kept that way.

Application.Calculation = xlCalculationAutomatic

Range("Y1").Select
ActiveCell.FormulaR1C1 = "=WEEKDAY(RC[-23])"
Range("Y1").Select
Set AutoFillRg = Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, -1).End(xlDown))
Selection.AutoFill Destination:=Range(ActiveCell.Address, AutoFillRg.Offset(0, 1).Address)



Range("AA1").Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[-25])"
Range("AB1").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-1],3,4)"
Range("Z1").Select
ActiveCell.FormulaR1C1 = "=R1C28&""-""&RC[-3]"

Range("z1").Select
Set AutoFillRg = Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, -1).End(xlDown))
Selection.AutoFill Destination:=Range(ActiveCell.Address, AutoFillRg.Offset(0, 1).Address)
' to add 04- before the ORC numbers
Application.Calculation = xlCalculationManual
Columns("Z:Z").Select
Selection.Copy
Range("W1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("W:W").EntireColumn.AutoFit
Columns("Z:AC").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("AA9").Select


Workbooks.OpenText Filename:="C:\temp\2004 acc\DATA\sms05000.txt", DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2))
Cells.Select
Selection.ColumnWidth = 8.57
Cells.EntireColumn.AutoFit



Range("N1").Select
ActiveCell.FormulaR1C1 = "=LOOKUP(RC[-13],sms01000.txt!C1,sms01000.txt!C23)"
Application.Calculation = xlCalculationAutomatic
Range("N1").Select
Set AutoFillRg = Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, -1).End(xlDown))
Selection.AutoFill Destination:=Range(ActiveCell.Address, AutoFillRg.Offset(0, 1).Address)
Columns("N:N").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("N:N").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Cells.Select
Cells.EntireColumn.AutoFit
'i replaced the above code as per ponsonby to read as,Range([N1], [M1].End(xlDown)(1, 2)).FormulaR1C1 = "=LOOKUP(RC[-13],sms01000.txt!C1,sms01000.txt!C23)"
'Columns("A:A") = Columns("N:N").Value
'Columns("N:N").Delete
'Cells.Columns.AutoFit



Application.Calculation = xlCalculationManual
Workbooks.OpenText Filename:="C:\temp\2004 acc\DATA\sms06000.txt", DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2))
Cells.Select
Selection.ColumnWidth = 8.57
Cells.EntireColumn.AutoFit



Range("F1").Select
ActiveCell.FormulaR1C1 = "=LOOKUP(RC[-5],sms01000.txt!C1,sms01000.txt!C23)"
Application.Calculation = xlCalculationAutomatic
Range("F1").Select
Set AutoFillRg = Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, -1).End(xlDown))
Selection.AutoFill Destination:=Range(ActiveCell.Address, AutoFillRg.Offset(0, 1).Address)
Application.Calculation = xlCalculationManual
Columns("F:F").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("F:F").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Cells.Select
Cells.EntireColumn.AutoFit
'i replaced the above code as per ponsonby to read as,Range([F1], [G1].End(xlDown)(1, 2)).FormulaR1C1 = "=LOOKUP(RC[-5],sms01000.txt!C1,sms01000.txt!C23)"
'Columns("A:A") = Columns("F:F").Value
'Columns("F:F").Delete
'Cells.Columns.AutoFit
Application.Calculation = xlCalculationManual
Workbooks.OpenText Filename:="C:\temp\2004 acc\DATA\sms08000.txt", DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2))
Cells.Select
Selection.ColumnWidth = 8.57
Cells.EntireColumn.AutoFit

Range("o1").Select
ActiveCell.FormulaR1C1 = "=LOOKUP(RC[-14],sms01000.txt!C1,sms01000.txt!C23)"
Application.Calculation = xlCalculationAutomatic
Range("o1").Select
Set AutoFillRg = Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, -1).End(xlDown))
Selection.AutoFill Destination:=Range(ActiveCell.Address, AutoFillRg.Offset(0, 1).Address)
Application.Calculation = xlCalculationManual
Columns("o").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("o").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Cells.Select
Cells.EntireColumn.AutoFit
'i replaced the above code as per ponsonby to read as,Range([O1], [P1].End(xlDown)(1, 2)).FormulaR1C1 = "=LOOKUP(RC[-14],sms01000.txt!C1,sms01000.txt!C23)"
'Columns("A:A") = Columns("O:O).Value
'Columns("O:O").Delete
'Cells.Columns.AutoFit

'
' and so on.. the code is repitative for the rest of the files
'
'
'for 8 more files
'
'
'
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub



Thanks!

 

[Legacy 12630]

I don't have time to go through this at present.

Perhaps someone else could take a look.

In the meantime, probably better to put the sheet ref in this formula :-
ActiveCell.FormulaR1C1 = "=LOOKUP(RC[-13],sms01000.txt!C1,sms01000.txt!C23)"

Also, your line :-

Range([O1], [P1].End(xlDown)(1, 2)).FormulaR1C1 = "=LOOKUP(RC[-14],sms01000.txt!C1,sms01000.txt!C23)"

is not the same as I suggested you use.
Have a look at my previous post again.
[P1] in your version should be [N1]