Append to bottom of other Worksheet

[GIS]

Hi All,
I am hoping someone here can help me out or point me to something that can. I don't have much experience with VBA, though I have a background in Java.

Here is the situation: I'm writing a macro that will pull rows from one worksheet and paste them into the corresponding worksheet based on a keyword in column F. Right now everything is working but the rows are only appending to the bottom of the worksheets if I enter the row number seperately in a text box. What I would like is for the macro to determine where the first empty row is and go from there. Ideally there will as little user input as possible.

I know there are ways of doing this but I haven't been successful incorporating it into my code.

Any suggestions?

Private Sub QAQC()
Dim LSearchRow As Long
Dim LCopyToRow8 As Long
Dim LCopyToRow6 As Long
Dim LCopyToRowB As Long
Dim LCopyToRowD As Long
Dim wksInput As Worksheet
Dim wksOutput8 As Worksheet 
Dim wksOutput6 As Worksheet 
Dim wksOutputB As Worksheet 
Dim wksOutputD As Worksheet 
 
Application.ScreenUpdating = False
Set wksInput = ThisWorkbook.Worksheets(TxtSheet.Text)
Set wksOutput8 = ThisWorkbook.Worksheets("STD 8")
Set wksOutput6 = ThisWorkbook.Worksheets("Std 6")
Set wksOutputB = ThisWorkbook.Worksheets("BLANK")
Set wksOutputD = ThisWorkbook.Worksheets("Duplicates")
 
'User inputs row number
LCopyToRow8 = TxtStd8.Text
LCopyToRow6 = TxtStd6.Text
LCopyToRowB = TxtBlank.Text
LCopyToRowD = TxtD.Text
 
Dim agValue As String
Dim moValue As String
Dim auValue As String
Dim cuValue As String
Dim assaySample As String
 
For LSearchRow = 3 To wksInput.UsedRange.Rows.Count
    If wksInput.Cells(LSearchRow, 6) = "STANDARD CM-8" Then
        wksInput.Rows(LSearchRow).Copy wksOutput8.Cells(LCopyToRow8, 1)
        LCopyToRow8 = LCopyToRow8 + 1
    ElseIf wksInput.Cells(LSearchRow, 6) = "STANDARD CM-6" Then
        wksInput.Rows(LSearchRow).Copy wksOutput6.Cells(LCopyToRow6, 1)
        LCopyToRow6 = LCopyToRow6 + 1
    ElseIf wksInput.Cells(LSearchRow, 6) = "BLANK" Then
        wksInput.Rows(LSearchRow).Copy wksOutputB.Cells(LCopyToRowB, 1)
        LCopyToRowB = LCopyToRowB + 1
    ElseIf wksInput.Cells(LSearchRow, 6) Like "DUPLICADO*" Then
        assaySample = wksInput.Cells(LSearchRow, 6)
        wksInput.Rows(LSearchRow).Copy wksOutputD.Cells(LCopyToRowD, 1)
        auValue = wksInput.Cells(LSearchRow - 1, 8)
        moValue = wksInput.Cells(LSearchRow - 1, 9)
        cuValue = wksInput.Cells(LSearchRow - 1, 10)
        agValue = wksInput.Cells(LSearchRow - 1, 13)
 
        wksOutputD.Cells(LCopyToRowD, 33) = auValue
        wksOutputD.Cells(LCopyToRowD, 34) = moValue
        wksOutputD.Cells(LCopyToRowD, 35) = cuValue
        wksOutputD.Cells(LCopyToRowD, 36) = agValue
        LCopyToRowD = LCopyToRowD + 1
 
    End If
Next LSearchRow
    MsgBox "Process Complete."
Exit Sub
 
Application.ScreenUpdating = True
End Sub

 

[wigi]

Consider the much shorter:

Private Sub QAQC()

    Dim LSearchRow As Long
    Dim wksInput As Worksheet

    Application.ScreenUpdating = False
    ThisWorkbook.Activate
    Set wksInput = Worksheets(TxtSheet.Text)

    With wksInput

        For LSearchRow = 3 To wksInput.UsedRange.Rows.Count
            If .Cells(LSearchRow, 6) = "STANDARD CM-8" Then
                .Rows(LSearchRow).Copy Worksheets("STD 8").Range("A" & Rows.Count).End(xlUp).Offset(1)
            ElseIf .Cells(LSearchRow, 6) = "STANDARD CM-6" Then
                .Rows(LSearchRow).Copy Worksheets("Std 6").Range("A" & Rows.Count).End(xlUp).Offset(1)
            ElseIf .Cells(LSearchRow, 6) = "BLANK" Then
                .Rows(LSearchRow).Copy Worksheets("BLANK").Range("A" & Rows.Count).End(xlUp).Offset(1)
            ElseIf .Cells(LSearchRow, 6) Like "DUPLICADO*" Then
                .Rows(LSearchRow).Copy Worksheets("Duplicates").Range("A" & Rows.Count).End(xlUp).Offset(1)

                Worksheets("Duplicates").Cells(Rows.Count, 1).End(xlUp).Offset(, 32).Resize(, 4).Value = _
                Array(.Cells(LSearchRow - 1, 8), .Cells(LSearchRow - 1, 9), .Cells(LSearchRow - 1, 10), .Cells(LSearchRow - 1, 13))

            End If
        Next
    End With
    Application.ScreenUpdating = True
    MsgBox "Process Complete."
End Sub

 

[GIS]

Wow, thank you so much for your help. Much more than I was expecting!
Your code is much more concise and works wonderfully.
Thank you again!

 

[wigi]

You're welcome

Hope you can steal some programming concepts in VBA from that code