need quick help with simple excel program

[CalibreUnion]

hey guys, this is my code I am doing for a simple excel program for school. There seems to be an issue with the filter part as I am unable to use the filter. Anyone could help me out?

Private Sub CommandButton1_Click()
EraseWorkSheetKeepRow1 ("FilteredItems")
Sheets("CustomerInfo").Select
Dim i As Integer
Dim k As Integer
k = Application.WorksheetFunction.CountA(Range("A:A"))
For i = 2 To k
Sheets("CustomerInfo").Select
If Val(Cells(i, 3)) > Val(TextBox1.Text) Then
Call Copy1row("CustomerInfo", i, "FilteredItems")
End If
Next
End Sub


Sub EraseWorkSheetKeepRow1(sheetname As String)
'
' EraseWorkSheetKeepRow1 Macro
' Erase all rows except row 1 for worksheet
ActiveWorkbook.Sheets(sheetname).Select
Dim k As Integer
k = Application.WorksheetFunction.CountA(Range("A:A")) + 1
Range("A2:C" & k).Select
Selection.ClearContents
End Sub
Sub Copy1row(FromSheet As String, rowno As Integer, ToSheet As String)
'
' Copy1row Macro
Sheets(FromSheet).Select
Rows(rowno & ":" & rowno).Select
Selection.Copy
Sheets(ToSheet).Select
Dim k As Integer
k = Application.WorksheetFunction.CountA(Range("A:A")) + 1
Rows(k & ":" & k).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End Sub

Thanks in advance

 

[peterchan75]

I have 2 suggestion to simplify your subroutines.

1. Delete all rows except the first row subroutine.
ThisWorkbook.Sheets(sheetname).Rows("2:10000").Delete
If 10,000 rows is not sufficient, then add more zeros.

2. Copy 1 row subroutine.
Usually, when copy a row from 1 sheet to another, there should be 2 indexes i.e. 1 for the source and 1 for destination. Unless, the source and destination indexes are the same.
ThisWorkbook.Sheets(FromSheet).Rows(index1).Copy
ThisWorkbook.Sheets(ToSheet).Rows(index2).PasteSpecial xlPasteValues
If you need to copy formula then change xlPasteValues to xlPasteFormulas.

 

[stay8899]

I assumed you are trying to copy all rows filtered in the "CustomerInfo" based on some criteria and paste the values of the filtered rows to "FilteredItems"

Since you are copying rows, it is further assumed that the header row in CustomerInfo is the same as FilteredItems -> Not necessary to delete from row 2 onwards, just delete everything and copy the header row from customerinfo.

Private Sub CommandButton1_Click()
'Clear entire filteredItems worksheet
ThisWorkbook.Sheets("FilteredItems").UsedRange.Delete
'Copy CustomerInfo - not necessary to select row by row as copy and paste will
'automatically copied only filtered rows
ThisWorkbook.Sheets("CustomerInfo").UsedRange.Copy
ThisWorkbook.Sheets("FilteredItems").Range("A1").PasteSpecial xlPasteValues
End Sub

If header is different in both worksheets, modify:
sheets(x).Rows("2:" & sheets(x).usedRange.Rows.Count).Delete
sheets.Rows("2:" & sheets.usedRange.Rows.Count).Copy
sheets(x).Range("A2").Paste....

Hope this helps.