Hello, I am relatively new to VBA. I'm trying to build a command button that will allow me sort and move my data quickly. I get about 1000 lines of data daily and I would love to automate this process with a VBA loop. I currently have a workbook with about 8 worksheets, the 2 i'm concerend about are "Data" and "RPM Dept". I'm trying to write a code that will look at the "Data" worksheet in cols "I" & "P". IF col "I" = "R" and col "P" = "RPM Operations" I want to cut the entire row and paist it to sheet "RPM Dept" starting at row 50 or the next avalable row. Then I want it to go back to "Data" and loop until it has checked all of the data. so far I've been able to write a code that works but only pulls one at a time, and only for the critieria of col "P" = "RPM Operations". Any help or suggestions would be greatly appreciated! below is the code i have worked out so far:
Private Sub CommandButton1_Click()
Dim Cell As Range
Dim DstWks As Worksheet
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim LSearchValue As String
Dim MatchCell As Range
Dim R As Long
Dim RngEnd As Range
Dim SrcWks As Worksheet
Dim LCutandPasteToRow As Integer
Dim Addx As String
Set DstWks = Worksheets("RPM Dept")
Set SrcWks = Worksheets("Data")
LSearchValue = "RPM Operations"
'Start search in row 5
LSearchRow = 2
Set RngEnd = DstWks.Cells(Rows.Count, "A").End(xlUp)
LSearchRow = IIf(RngEnd.Row < LSearchRow, LSearchRow, RngEnd.Row + 1)
'Start copying data to row 2 in Sheet2 (row counter variable)
LCutandPasteToRow = 50
Set MatchCell = SrcWks.Cells.Find(LSearchValue, , xlValues, xlWhole, xlByRows, xlNext, False)
Addx = MatchCell.Address
If Not MatchCell Is Nothing Then
Application.ScreenUpdating = False
R = MatchCell.Row
MatchCell.EntireRow.Cut Destination:=DstWks.Cells(LSearchRow, "A")
SrcWks.Rows(R).Delete Shift:=xlShiftUp
Application.ScreenUpdating = True
End If
End Sub
Private Sub CommandButton1_Click()
Dim Cell As Range
Dim DstWks As Worksheet
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim LSearchValue As String
Dim MatchCell As Range
Dim R As Long
Dim RngEnd As Range
Dim SrcWks As Worksheet
Dim LCutandPasteToRow As Integer
Dim Addx As String
Set DstWks = Worksheets("RPM Dept")
Set SrcWks = Worksheets("Data")
LSearchValue = "RPM Operations"
'Start search in row 5
LSearchRow = 2
Set RngEnd = DstWks.Cells(Rows.Count, "A").End(xlUp)
LSearchRow = IIf(RngEnd.Row < LSearchRow, LSearchRow, RngEnd.Row + 1)
'Start copying data to row 2 in Sheet2 (row counter variable)
LCutandPasteToRow = 50
Set MatchCell = SrcWks.Cells.Find(LSearchValue, , xlValues, xlWhole, xlByRows, xlNext, False)
Addx = MatchCell.Address
If Not MatchCell Is Nothing Then
Application.ScreenUpdating = False
R = MatchCell.Row
MatchCell.EntireRow.Cut Destination:=DstWks.Cells(LSearchRow, "A")
SrcWks.Rows(R).Delete Shift:=xlShiftUp
Application.ScreenUpdating = True
End If
End Sub
