Hello, I am a total new guy to all the VBA scripting, so please forgive any ignorance... but I want to learn!!
I have a filter macro that loops through 20 different criteria. It pastes the results of each loop onto a sheet below the previous results.
It then calls a sub routine that the simply performs a count of rows with data and returns the result and pastes it into sheet2.
This code works perfectly on the one sheet that I have coded into it.
I am trying to get it to run this macro completely, enter the result and then proceed to execute the same thing on the next worksheet.
I currently have 10 worksheets that i need this particular version to run on, but the workbook will have many more sheets.
the sheet names are basically like the following ("06 scan", "28 scan", "44 scan", etc)
I am just stumped at how to get it to fully run, then progress to the next proper sheet
Here is the code sample that I have stumbled aruond with and got to work with just the one sheet that I code into it... (again I am new to all of this)
and thank you for any time in advance..
I will try to attach a copy of the file I am working on as well.
test-1.xlsm
I have a filter macro that loops through 20 different criteria. It pastes the results of each loop onto a sheet below the previous results.
It then calls a sub routine that the simply performs a count of rows with data and returns the result and pastes it into sheet2.
This code works perfectly on the one sheet that I have coded into it.
I am trying to get it to run this macro completely, enter the result and then proceed to execute the same thing on the next worksheet.
I currently have 10 worksheets that i need this particular version to run on, but the workbook will have many more sheets.
the sheet names are basically like the following ("06 scan", "28 scan", "44 scan", etc)
I am just stumped at how to get it to fully run, then progress to the next proper sheet
Here is the code sample that I have stumbled aruond with and got to work with just the one sheet that I code into it... (again I am new to all of this)
and thank you for any time in advance..
I will try to attach a copy of the file I am working on as well.
test-1.xlsm
Code:
Sub FilterMe()
' created 1-25-13
' Filters the pasted .txt data on sheet and counts the results from the filters and pastes results into a cell
Dim Crit(1 To 20) As String
Dim WBName As String
Crit(1) = "1-*"
Crit(2) = "2-*"
Crit(3) = "3-*"
Crit(4) = "4-*"
Crit(5) = "5-*"
Crit(6) = "6-*"
Crit(7) = "7-*"
Crit(8) = "8-*"
Crit(9) = "9-*"
Crit(10) = "10-*"
Crit(11) = "AA*"
Crit(12) = "AB*"
Crit(13) = "AC*"
Crit(14) = "AD*"
Crit(15) = "AE*"
Crit(16) = "AF*"
Crit(17) = "AG*"
Crit(18) = "AH*"
Crit(19) = "AI*"
Crit(20) = "AJ*"
WBName = "test-1.xlsm"
Workbooks(WBName).Activate
For n = 1 To UBound(Crit)
Sheets("06 scan").Activate ' This is the sheet that is currently having the data extracted from
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False ' To remove any previous filter settings (if any)
ActiveSheet.Range("A1:A9991").AutoFilter Field:=1, Criteria1:=Crit(n) ' Sets the range and criteria to be filtered
ActiveSheet.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy ' Selects only the results from the filter and copies
Workbooks(WBName).Worksheets("Sheet1").Activate ' Activates the destination sheet of filtered results
Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'Finds first empty cell in column A, below cell A1
Workbooks(WBName).Worksheets("Sheet1").Paste ' Pastes filtered data results
Worksheets("Sheet1").Range("A1").Select ' just brings the active point to cell A1 (not really needed to make code work)
Application.CutCopyMode = False ' clears any remaining content on clipboard
Next n
Call TestCount1 ' Calls sub routine to count the results and paste into a cell
Workbooks(WBName).Worksheets("Sheet1").Cells.ClearContents ' Clears all of the un-needed data after it is counted on the sheet
Workbooks(WBName).Worksheets("Sheet2").Activate ' Activates Sheet2 to show you the results of the routine
End Sub
Sub TestCount1()
CntData ("Sheet1!A:A")
End Sub
Sub CntData(sRange As String)
Dim countNonBlank As Integer, myRange As Range
Set myRange = Range(sRange)
countNonBlank = Application.WorksheetFunction.CountA(myRange)
'MsgBox "Item Count: " & countNonBlank, , sRange
Worksheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1) = countNonBlank
End Sub
