Ok more help with VBA I'm sure you can see a trend here.
As per my previous thread I am setting up an excel workbook with a master sheet Raw Data Excel and this master sheet populates the department worksheets.
One of the parts I need to populate is student data according to headings namely:
last name First name Reg Group *Department* Group *Department* Teacher *Department* EFG-FFT *Department* Effort *Department* Homework
*Department* will change with each worksheet
I have VBA code which will copy all the student data mapped to the headings, however, I have no idea on how to filter the rows within the code. What I would like to do is:
Filter the Department EFG-FFT to show all values 0 and above
Filter Effort for all values 2 and below (to include blanks)
Filter Homework for all values 2 and below (to include blanks)
then deleted all the filtered rows and unfilter the remainder.
The code I am using to copy the data across is:
Any help would be most welcome.
Thanks
As per my previous thread I am setting up an excel workbook with a master sheet Raw Data Excel and this master sheet populates the department worksheets.
One of the parts I need to populate is student data according to headings namely:
last name First name Reg Group *Department* Group *Department* Teacher *Department* EFG-FFT *Department* Effort *Department* Homework
*Department* will change with each worksheet
I have VBA code which will copy all the student data mapped to the headings, however, I have no idea on how to filter the rows within the code. What I would like to do is:
Filter the Department EFG-FFT to show all values 0 and above
Filter Effort for all values 2 and below (to include blanks)
Filter Homework for all values 2 and below (to include blanks)
then deleted all the filtered rows and unfilter the remainder.
The code I am using to copy the data across is:
Code:
Sub CopyStudent()
Dim intErrCount As Integer
' create worksheet objects
Dim shtSource As Worksheet: Set shtSource = Sheets("Raw Data excel")
Dim shtTarget As Worksheet: Set shtTarget = ActiveSheet
' create range objects
Dim rngSourceHeaders As Range: Set rngSourceHeaders = shtSource.Range("1:1")
With shtTarget
Dim rngTargetHeaders As Range: Set rngTargetHeaders = .Range("A" & ActiveCell.Row).Resize(, 10)
Dim rngPastePoint As Range: Set rngPastePoint = .Cells(.Rows.Count, 1).End(xlUp).Offset(1) 'Shoots up from the bottom of the sheet untill it bumps into something and steps one down
End With
Dim rngDataColumn As Range
' process data
Dim cl As Range, i As Integer
For Each cl In rngTargetHeaders ' loop through each cell in target header row
' identify source location
i = 0 ' reset I
On Error Resume Next ' ignore errors, these are where the value can't be found and will be tested later
i = Application.Match(cl.Value, rngSourceHeaders, 0) 'Finds the matching column name
On Error GoTo 0 ' switch error handling back off
' report if source location not found
If i = 0 Then
intErrCount = intErrCount + 1
Debug.Print "unable to locate item [" & cl.Value & "] at " & cl.Address ' this reports to Immediate Window (Ctrl + G to view)
GoTo nextCL
End If
' create source data range object
With rngSourceHeaders.Cells(1, i)
Set rngDataColumn = Range(.Cells(2, 1), .Cells(1000000, 1).End(xlUp))
End With
' pass to target range object
cl.Offset(1, 0).Resize(rngDataColumn.Rows.Count, rngDataColumn.Columns.Count).Value = rngDataColumn.Value
nextCL:
Next cl
' confirm process completion and issue any warnings
If intErrCount = 0 Then
MsgBox "process completed"
End If
End SubAny help would be most welcome.
Thanks
