Simplifying code

Hi,

I have 20 worksheets which need the same code, below is code for first
two worksheets which you can see is the same apart from worksheet
and target names.
Rather than copying and pasting code 19 times and replacing worksheet
and target names, I would like something far shorter and efficient,
maybe an array which goes through all 20 worksheets?

The code is meant to go through 20 sheets, the summary sheet (here,
referenced as "sr") takes values through lookups on each sheet.

Many Thanks

'1) Worksheet abn
Set wss = Worksheets("abn")
wss.Select
target = "abn"
Cells.Find(What:="itebal", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
itebalcol = ActiveCell.Column

For i = 500 To 2 Step -1
If Left(sr.Cells(i, 1), 3) = target And sr.Cells(i, 1).Offset(0, 25) = "GBP" Then
sr.Cells(i, 6) = WorksheetFunction.VLookup(sr.Cells(i, 1), wss.Range("A1:Z10000"), itebalcol, 0)
End If
If Left(sr.Cells(i, 1), 3) = target And sr.Cells(i, 1).Offset(0, 25) = "EUR" Then
sr.Cells(i, 6) = WorksheetFunction.VLookup(sr.Cells(i, 1), wss.Range("A1:Z10000"), itebalcol, 0)
End If
If Left(sr.Cells(i, 1), 3) = target And sr.Cells(i, 1).Offset(0, 25) = "USD" Then
sr.Cells(i, 6) = WorksheetFunction.VLookup(sr.Cells(i, 1), wss.Range("A1:Z10000"), itebalcol, 0)
End If
If Left(sr.Cells(i, 1), 3) = target And sr.Cells(i, 1).Offset(0, 25) = "RUB" Then
sr.Cells(i, 6) = WorksheetFunction.VLookup(sr.Cells(i, 1), wss.Range("A1:Z10000"), itebalcol, 0)
End If
If Left(sr.Cells(i, 1), 3) = target And _
sr.Cells(i, 1).Offset(0, 25) <> "GBP" And sr.Cells(i, 1).Offset(0, 25) <> "EUR" And sr.Cells(i, 1).Offset(0, 25) <> "USD" And sr.Cells(i, 1).Offset(0, 25) <> "RUB" Then
sr.Cells(i, 10) = WorksheetFunction.VLookup(sr.Cells(i, 1), wss.Range("A1:Z10000"), itebalcol, 0)
End If

'2) Worksheet cap
Set wss = Worksheets("cap")
wss.Select
target = "cap"
Cells.Find(What:="itebal", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
itebalcol = ActiveCell.Column

For i = 500 To 2 Step -1
If Left(sr.Cells(i, 1), 3) = target And sr.Cells(i, 1).Offset(0, 25) = "GBP" Then
sr.Cells(i, 6) = WorksheetFunction.VLookup(sr.Cells(i, 1), wss.Range("A1:Z10000"), itebalcol, 0)
End If
If Left(sr.Cells(i, 1), 3) = target And sr.Cells(i, 1).Offset(0, 25) = "EUR" Then
sr.Cells(i, 6) = WorksheetFunction.VLookup(sr.Cells(i, 1), wss.Range("A1:Z10000"), itebalcol, 0)
End If
If Left(sr.Cells(i, 1), 3) = target And sr.Cells(i, 1).Offset(0, 25) = "USD" Then
sr.Cells(i, 6) = WorksheetFunction.VLookup(sr.Cells(i, 1), wss.Range("A1:Z10000"), itebalcol, 0)
End If
If Left(sr.Cells(i, 1), 3) = target And sr.Cells(i, 1).Offset(0, 25) = "RUB" Then
sr.Cells(i, 6) = WorksheetFunction.VLookup(sr.Cells(i, 1), wss.Range("A1:Z10000"), itebalcol, 0)
End If
If Left(sr.Cells(i, 1), 3) = target And _
sr.Cells(i, 1).Offset(0, 25) <> "GBP" And sr.Cells(i, 1).Offset(0, 25) <> "EUR" And sr.Cells(i, 1).Offset(0, 25) <> "USD" And sr.Cells(i, 1).Offset(0, 25) <> "RUB" Then
sr.Cells(i, 10) = WorksheetFunction.VLookup(sr.Cells(i, 1), wss.Range("A1:Z10000"), itebalcol, 0)
End If

The first idea I have may be this code:

Please Login or Register  to view this content.

Regards,
Antonio

I apologize to select a wrong color.

Please Login or Register  to view this content.

Hi,

Thaks for the reply, however am not sure this will work as I am not looping through all worksheets, only specific ones.

Many Thanks

Hello T De Villiers,

Add a Standard VBA module to your workbook and then copy and paste the maco code into it. See the example below for calling the macro in your code.

Please Login or Register  to view this content.

Calling the Macro:
Your code now looks like this....
SummaryMacro "abn"
SummaryMacro "cap"
...etc

Sincerely,
Leith Ross