I'm very new to progamming kind of stuff... i need to generate a report from a excel sheet.
Coloumn Q of "data" sheet has only 0 or 1, which is output of some formula calculation.
I need all 1 to be copied to "SHO" sheet. based on the copied content i need to impletement some formula. value 1 will not be same always. if today q coulmn is 1 for a row, tomorrow it may be 0... Max 600 rows need to be supported. Kindly help..
1. Goto Tool and start macro recorder
2. Apply filters on column Q for the value u want to copy for
3. Copy all the visible rows
4. paste on the other sheet SHO
5. Stop the macro
This will give you a generic template. Things to modify would be
1. What is the last row to be copied
2. If rows are to be appended to that SHO sheet, then from what row you should paste. For both you can use the function below
Sample Call
lMaxRows = getItemLocation("*", Sheets("SHO").Cells)
Note if sheet is blank then it will return 0
Public Function getItemLocation(sLookFor As String, _
rngSearch As Range, _
Optional bFullString As Boolean = True, _
Optional bLastOccurance As Boolean = True, _
Optional bFindRow As Boolean = True) As Long
Dim Cell As Range
Dim iLookAt As Integer
Dim iSearchDir As Integer
Dim iSearchOdr As Integer
If (bFullString) _
Then
iLookAt = xlWhole
Else
iLookAt = xlPart
End If
If (bLastOccurance) _
Then
iSearchDir = xlPrevious
Else
iSearchDir = xlNext
End If
If Not (bFindRow) _
Then
iSearchOdr = xlByColumns
Else
iSearchOdr = xlByRows
End If
With rngSearch
If (bLastOccurance) _
Then
Set Cell = .Find(sLookFor, .Cells(1, 1), xlValues, iLookAt, iSearchOdr, iSearchDir)
Else
Set Cell = .Find(sLookFor, .Cells(.Rows.Count, .Columns.Count), xlValues, iLookAt, iSearchOdr, iSearchDir)
End If
End With
If Cell Is Nothing Then
getItemLocation = 0
ElseIf Not (bFindRow) _
Then
getItemLocation = Cell.Column
Else
getItemLocation = Cell.Row
End If
Set Cell = Nothing
End Function
Sub doCopyFilteredData()
Dim sSrcSht As String
Dim lLastRow As Long
Dim lLastCol As Long
sSrcSht = "Sheet1"
With Sheets(sSrcSht)
'remove any existing filters
Application.ScreenUpdating = False
.AutoFilterMode = False
'FIND LAST USED COLUMN
lLastCol = getItemLocation("*", .Cells, bFindRow:=False)
'APPLY FILTER
.Cells.AutoFilter Field:=17, Criteria1:="1"
'FIND LAST VISIBLE ROW
lLastRow = getItemLocation("*", .Cells)
If lLastRow > 0 _
Then
'FREE MEMORY OF ANY COPIED INFORMATION
Application.CutCopyMode = False
'CLEAR PREVIOUS DATA
Sheets("SHO").Cells.Clear
'COPY FILTERED DATA
.Range(.Cells(1, 1), .Cells(lLastRow, lLastCol)).Copy
'PASTE FILTERED DATA
Sheets("SHO").Cells(1, 1).PasteSpecial
'REMOVE ANY FILTER
Application.CutCopyMode = False
End If
.AutoFilterMode = False
Application.ScreenUpdating = True
End With
End Sub
Public Function getItemLocation(sLookFor As String, _
rngSearch As Range, _
Optional bFullString As Boolean = True, _
Optional bLastOccurance As Boolean = True, _
Optional bFindRow As Boolean = True) As Long
Dim Cell As Range
Dim iLookAt As Integer
Dim iSearchDir As Integer
Dim iSearchOdr As Integer
If (bFullString) _
Then
iLookAt = xlWhole
Else
iLookAt = xlPart
End If
If (bLastOccurance) _
Then
iSearchDir = xlPrevious
Else
iSearchDir = xlNext
End If
If Not (bFindRow) _
Then
iSearchOdr = xlByColumns
Else
iSearchOdr = xlByRows
End If
With rngSearch
If (bLastOccurance) _
Then
Set Cell = .Find(sLookFor, .Cells(1, 1), xlValues, iLookAt, iSearchOdr, iSearchDir)
Else
Set Cell = .Find(sLookFor, .Cells(.Rows.Count, .Columns.Count), xlValues, iLookAt, iSearchOdr, iSearchDir)
End If
End With
If Cell Is Nothing Then
getItemLocation = 0
ElseIf Not (bFindRow) _
Then
getItemLocation = Cell.Column
Else
getItemLocation = Cell.Row
End If
Set Cell = Nothing
End Function
