loop trough filter list

[Sjon1974]

All,

I have problem. I making a program that when a new period is imported then it needs to create subtotals and copy that in a specific field.
But i have per department a different worksheet (layout is all the same) Instead of copying everything 20000 times per period and department. I want to loop trough the list of departments.

This is what i have now, but now i am calling everytime to the new department. 13 department and 24 periods......

Sub BPO1()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim LASTROW As Long
    Dim Cl As Range
    Set ws1 = ThisWorkbook.Sheets("Database")
    Set ws2 = ThisWorkbook.Sheets("ACUM BPO")
    ws1.Range("G1").AutoFilter 7, "1"
    ws1.Range("G1").AutoFilter 203, "ACUM BPO"
    ws2.Range("C6") = "=SUBTOTAL(9,sueldo)"
    ws2.Range("C15") = "=SUBTOTAL(9,SUBSIDIO)"
    ws2.Range("C21") = "=SUBTOTAL(9,PRIMA_VACACIONAL)"
    ws2.Range("C22") = "=SUBTOTAL(9,VACACIONES)"
    ws2.Range("C32") = "=SUBTOTAL(9,ISR_A_CARGO)"
    ws2.Range("C57") = "=SUBTOTAL(9,CREDITO_INFONAVIT)"
    ws2.Range("C58") = "=SUBTOTAL(9,CREDITO_FONACOT)"
    ws2.Range("C59") = "=SUBTOTAL(9,IMSS)"
    'copy
    ws2.Range("C6:C28").Copy
    ws2.Range("C6:C28").PasteSpecial Paste:=xlPasteValues
    ws2.Range("C32:C60").Copy
    ws2.Range("C32:C60").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Call IPSAM1
    End Sub

problem is that the ws2 is changing the whole time to the new worksheet of the departement.

 

[DanteAmor]

   ws1.Range("G1").AutoFilter 7, "1"
   ws1.Range("G1").AutoFilter 203, "ACUM BPO"
   ws2.Range("C6") = "=SUBTOTAL(9,sueldo)"

You can briefly comment:
I suppose that in column 7 (G) you have the periods and in column 203 (GU) the departments.
The filter for period "1" goes in cell C6. Does the filter for period "2" go in the same cell C6?
How many records do you have in the "Database" sheet
I suppose that all the sheets of all the departments are created.
The named ranges ("sueldo", "subsidio", etc) are within the 203 columns on "Database"
So you have to go 24 periods for each department?

 

[Sjon1974]

The filter for period "1" goes in cell C6. Does the filter for period "2" go in the same cell C6?

That is the problem period 2 goes to D6, period 3 goes to I6 etc

How many records do you have in the "Database" sheet

I have around at this moment 2000 rows, so by the end of the year 4000.

I suppose that all the sheets of all the departments are created.
The named ranges ("sueldo", "subsidio", etc) are within the 203 columns on "Database"
So you have to go 24 periods for each department?

Yes, yes and yes.

 

[DanteAmor]

That is the problem period 2 goes to D6, period 3 goes to I6 etc

Period 1 in column C, period 2 in D, period 3 in I, is there a pattern to know which period goes in which column or are there 24 different columns without pattern?
You can put the list here: period - column

 

[Sjon1974]

All sheets are the same layout periodo column 1​ c 2​ d 3​ g 4​ h 5​ k 6​ l 7​ o 8​ p 9​ s 10​ t 11​ x 12​ y 13​ ab 14​ ac 15​ af 16​ ag 17​ aj 18​ ak 19​ an 20​ ao 21​ ar 22​ as 23​ av 24​ aw

 

[DanteAmor]

You have 2 periods together and then a 2 column separation and again 2 periods together, except in period 10 that you have a 3 column separation. It is right?

 

[DanteAmor]

Try this:

Sub BPO2()
  Dim ws1 As Worksheet, ws2 As Worksheet, dic As Object
  Dim a As Variant, i As Long, ky As Variant, col As Variant
  
  Application.ScreenUpdating = False
  Set ws1 = ThisWorkbook.Sheets("Database")
  Set dic = CreateObject("Scripting.Dictionary")
  
  col = Array("", "c", "d", "g", "h", "k", "l", "o", "p", "s", "t", "x", "y", _
              "ab", "ac", "af", "ag", "aj", "ak", "an", "ao", "ar", "as", "av", "aw")
  
  If ws1.AutoFilterMode Then ws1.AutoFilterMode = False
  a = ws1.Range("A2:GU" & ws1.Range("G" & Rows.Count).End(3).Row).Value2
  For i = 1 To UBound(a, 1)
    dic(a(i, 203)) = Empty
  Next
  
  For Each ky In dic.keys
    ws1.Range("G1").AutoFilter 203, ky
    Set ws2 = ThisWorkbook.Sheets(ky)
    For i = 1 To 24
      ws1.Range("G1").AutoFilter 7, i
      ws2.Cells(6, col(i)) = "=SUBTOTAL(9,sueldo)"
      ws2.Cells(15, col(i)) = "=SUBTOTAL(9,SUBSIDIO)"
      ws2.Cells(21, col(i)) = "=SUBTOTAL(9,PRIMA_VACACIONAL)"
      ws2.Cells(22, col(i)) = "=SUBTOTAL(9,VACACIONES)"
      ws2.Cells(32, col(i)) = "=SUBTOTAL(9,ISR_A_CARGO)"
      ws2.Cells(57, col(i)) = "=SUBTOTAL(9,CREDITO_INFONAVIT)"
      ws2.Cells(58, col(i)) = "=SUBTOTAL(9,CREDITO_FONACOT)"
      ws2.Cells(29, col(i)) = "=SUBTOTAL(9,IMSS)"
      ws2.Range(ws2.Cells(6, col(i)), ws2.Cells(28, col(i))).Value = ws2.Range(ws2.Cells(6, col(i)), ws2.Cells(28, col(i))).Value
      ws2.Range(ws2.Cells(32, col(i)), ws2.Cells(28, col(i))).Value = ws2.Range(ws2.Cells(60, col(i)), ws2.Cells(28, col(i))).Value
      Call IPSAM1
    Next
  Next
End Sub

 

[Sjon1974]

Try this:

Sub BPO2()
  Dim ws1 As Worksheet, ws2 As Worksheet, dic As Object
  Dim a As Variant, i As Long, ky As Variant, col As Variant
 
  Application.ScreenUpdating = False
  Set ws1 = ThisWorkbook.Sheets("Database")
  Set dic = CreateObject("Scripting.Dictionary")
 
  col = Array("", "c", "d", "g", "h", "k", "l", "o", "p", "s", "t", "x", "y", _
              "ab", "ac", "af", "ag", "aj", "ak", "an", "ao", "ar", "as", "av", "aw")
 
  If ws1.AutoFilterMode Then ws1.AutoFilterMode = False
  a = ws1.Range("A2:GU" & ws1.Range("G" & Rows.Count).End(3).Row).Value2
  For i = 1 To UBound(a, 1)
    dic(a(i, 203)) = Empty
  Next
 
  For Each ky In dic.keys
    ws1.Range("G1").AutoFilter 203, ky
    Set ws2 = ThisWorkbook.Sheets(ky)
    For i = 1 To 24
      ws1.Range("G1").AutoFilter 7, i
      ws2.Cells(6, col(i)) = "=SUBTOTAL(9,sueldo)"
      ws2.Cells(15, col(i)) = "=SUBTOTAL(9,SUBSIDIO)"
      ws2.Cells(21, col(i)) = "=SUBTOTAL(9,PRIMA_VACACIONAL)"
      ws2.Cells(22, col(i)) = "=SUBTOTAL(9,VACACIONES)"
      ws2.Cells(32, col(i)) = "=SUBTOTAL(9,ISR_A_CARGO)"
      ws2.Cells(57, col(i)) = "=SUBTOTAL(9,CREDITO_INFONAVIT)"
      ws2.Cells(58, col(i)) = "=SUBTOTAL(9,CREDITO_FONACOT)"
      ws2.Cells(29, col(i)) = "=SUBTOTAL(9,IMSS)"
      ws2.Range(ws2.Cells(6, col(i)), ws2.Cells(28, col(i))).Value = ws2.Range(ws2.Cells(6, col(i)), ws2.Cells(28, col(i))).Value
      ws2.Range(ws2.Cells(32, col(i)), ws2.Cells(28, col(i))).Value = ws2.Range(ws2.Cells(60, col(i)), ws2.Cells(28, col(i))).Value
      Call IPSAM1
    Next
  Next
End Sub

Cool, is it possible to have a aray for the different departments?
so that it does with one import all different worksheets? i have them in a named aray.
For example like the offset(0,1) ?

 

[DanteAmor]

is it possible to have a aray for the different departments?

The macro goes through all the departments that you have in column 203 (13 department), I suppose in column 203 you have all the departments.
Do you want to put in an array only the departments you want to process, that is, you have 13 department, but you only want 2, so you want to edit the macro, modify the array, put 2 departments and run the macro?

 

[Sjon1974]

ok, just a question (cause i recive a message script out of range)
How does the script knows the name of the different worksheets?

I am a sort of a newbie in VBA