looping programme require
I think you were getting an error because autofilter did not find any items
that met the criteria. I added a test for this condition. I also made the
loop go from "1 wk" to "7 wk". I changed the for loop as necessary to get
all the weeks.
Set Sht1 = Sheets("Sheet1")
Set Sht2 = Sheets("Sheet2")
LastRow = Sht1.Range("A" & Rows.Count).End(xlUp).Row
Sht1.Range("A1:J1").AutoFilter _
Field:=5, _
Criteria1:="CHF"
For wk = 1 To 7
Criteria = wk & " wk"
'check if criteria was found
Set c = Sht1.Range("A2:J" & LastRow).Find(what:=Criteria, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Sht1.Range("A1:J1").AutoFilter _
Field:=1, _
Criteria1:=Criteria
Set CopyRange = _
Sht1.Range("A2:J" & LastRow).SpecialCells(Type:=xlCellTypeVisible)
With Sht2
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
CopyRange.Copy _
Destination:=.Range("C" & NewRow)
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A" & NewRow) = Criteria
.Range("B" & NewRow) = "CHF"
.Range("D" & NewRow).Formula = _
"=vlookup(RC[-3],'Date_Calculation'!R1C11:R15C12,2)"
.Range("E" & NewRow) = "Total In"
.Range("F" & NewRow).Formula = _
"=SUMPRODUCT(--(Sheet1!R1C1:R65535C1=""1 wk"")," & _
"--(Sheet1!R1C5:R65535C5=""CHF""),(Sheet1!R1C6:R65535 C6))"
.Range("H" & NewRow) = "Total Out"
.Range("I" & NewRow).Formula = _
"=SUMPRODUCT(--(Sheet1!R1C1:R65535C1=""1 wk"")," & _
"--(Sheet1!R1C5:R65535C5=""CHF""),(Sheet1!R1C9:R65535 C9))"
.Range("J" & NewRow) = "Net"
.Range("J" & NewRow) = "=RC[-5]-RC[-2]"
End With
End If
Next wk
"Seeker" wrote:
I am a tyro and have a macro done to extract data from different files and
placed in €śsheet 1€ť columns A to J, a filter was added to select required
data and copy them to €śsheet 2€ť. Prime filter is in column E with different
currencies (tens of different currencies), each currencies need to check
another filter in column A if data contain in say 1 week, 1 month (15 tenors)
etc., add calculation at bottom after each loop. My macro only works for two
currencies, any more loop was rejected reason of €śProcedure too large€ť, your
assistance is needed to modify my macro to make it compile all looping.
Sheets("Sheet1").Select
Range("A1:J1").Select
Selection.AutoFilter Field:=5, Criteria1:="CHF"
Selection.AutoFilter Field:=1, Criteria1:="1 wk"
Range("A2:J2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Sheet2").Select
Range("A65536").End(xlUp).Offset(3, 0).Select
ActiveSheet.Paste
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "1 wk"
ActiveCell.Offset(0, 1).Select
ActiveCell.Formula = "CHF"
ActiveCell.Offset(0, 2).Select
ActiveCell.Formula = "=vlookup(RC[-3],'Date_Calculation'!R1C11:R15C12,2)"
ActiveCell.Offset(0, 1).Select
ActiveCell.Formula = "Total In"
ActiveCell.Offset(0, 1).Select
ActiveCell.Formula = "=SUMPRODUCT(--(Sheet1!R1C1:R65535C1=""1
wk""),--(Sheet1!R1C5:R65535C5=""CHF""),(Sheet1!R1C6:R65535 C6))"
ActiveCell.Offset(0, 2).Select
ActiveCell.Formula = "Total Out"
ActiveCell.Offset(0, 1).Select
ActiveCell.Formula = "=SUMPRODUCT(--(Sheet1!R1C1:R65535C1=""1
wk""),--(Sheet1!R1C5:R65535C5=""CHF""),(Sheet1!R1C9:R65535 C9))"
ActiveCell.Offset(0, 1).Select
ActiveCell.Formula = "Net"
ActiveCell.Offset(0, 1).Select
ActiveCell.Formula = "=RC[-5]-RC[-2]"
Sheets("Sheet1").Select
Selection.AutoFilter Field:=1, Criteria1:="2 wk"
Range("A2:J2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Printout").Select
Range("A65536").End(xlUp).Offset(3, 0).Select
ActiveSheet.Paste
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "2 wk"
ActiveCell.Offset(0, 1).Select
ActiveCell.Formula = "CHF"
ActiveCell.Offset(0, 2).Select
ActiveCell.Formula = "=vlookup(RC[-3],'Date_Calculation'!R1C11:R15C12,2)"
ActiveCell.Offset(0, 1).Select
ActiveCell.Formula = "Total In"
ActiveCell.Offset(0, 1).Select
ActiveCell.Formula = "=SUMPRODUCT(--(Sheet1!R1C1:R65535C1=""2
wk""),--(Sheet1!R1C5:R65535C5=""CHF""),(Sheet1!R1C6:R65535 C6))"
ActiveCell.Offset(0, 2).Select
ActiveCell.Formula = "Total Out"
ActiveCell.Offset(0, 1).Select
ActiveCell.Formula = "=SUMPRODUCT(--(Sheet1!R1C1:R65535C1=""2
wk""),--(Sheet1!R1C5:R65535C5=""CHF""),(Sheet1!R1C9:R65535 C9))"
ActiveCell.Offset(0, 1).Select
ActiveCell.Formula = "Net"
ActiveCell.Offset(0, 1).Select
ActiveCell.Formula = "=RC[-5]-RC[-2]"
Thanks in advance
Regards
|