Needed a VBA.
Solved/Closed
doss
-
Jun 1, 2011 at 02:36 PM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Jun 13, 2011 at 10:52 AM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Jun 13, 2011 at 10:52 AM
Related:
- Needed a VBA.
- Vba case like - Guide
- Excel online vba - Guide
- Vba timer - Guide
- Vba excel mac - Guide
- Vba color index - Guide
3 responses
rizvisa1
Posts
4478
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
766
Jun 1, 2011 at 02:57 PM
Jun 1, 2011 at 02:57 PM
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
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
Thank u rizvisa1
Thanks alot for your response..
I would be more thank full if u can explain how to use the macro i recorded.
macro code is
as i'm new bee in this stuff.. kindly help me out..wat need to be edited
Thanks alot for your response..
I would be more thank full if u can explain how to use the macro i recorded.
macro code is
Sub Macro6()
'
' Macro6 Macro
' R6
'
'
ActiveSheet.Range("$A$1:$Q$353").AutoFilter Field:=17, Criteria1:="1"
Rows("1:1").Select
Range("C1").Activate
Selection.EntireRow.Hidden = True
Cells.Select
Range("C1").Activate
Selection.Copy
Sheets("SHO").Select
ActiveSheet.Paste
Sheets("Data").Select
Application.CutCopyMode = False
ActiveSheet.ShowAllData
Rows("288:288").Select
Range("C288").Activate
ActiveWindow.SmallScroll Down:=-15
ActiveWindow.ScrollRow = 281
ActiveWindow.ScrollRow = 94
ActiveWindow.ScrollRow = 1
Rows("2:2").Select
Range("C2").Activate
Selection.EntireRow.Hidden = False
Rows("1:1").Select
Range("C1").Activate
Selection.EntireRow.Hidden = False
End Sub
as i'm new bee in this stuff.. kindly help me out..wat need to be edited
rizvisa1
Posts
4478
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
766
Jun 1, 2011 at 06:02 PM
Jun 1, 2011 at 06:02 PM
try this
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
Thank u rizvisa1
It works... thank u...
It works... thank u...
rizvisa1
Posts
4478
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
766
Jun 13, 2011 at 10:52 AM
Jun 13, 2011 at 10:52 AM
you are welcome
