VBA Code to Copy and Paste Specific Cells if condition is met into specified rows on same Sheet

64 views Asked by At

First,

Ricardo Diaz, I would like to thank you for your Macro. I am currently trying to find a Macro that would mimic this type of process but scan specific rows per shift and paste in the same sheet starting in a specific row and column and transcribe the information onto that row and populate down.

For some background, my work is utilizing an excel document to track our work and it is seperated in separate pages (still original sheet). it is broken down by shifts (Days, Swings & Mids).

For Mids their starting row for input is row 14 and the first page ends at row 53. The second page for Mids starts at row 64 and ends at row 118.

Days first page starting row is 133 and ends at row 177. The second page starts at row 188 and ends at row 242.

Swings first page starts at 257 and ends at row 295. The second page starts at row 306 and ends at row 362.

The function is when a button is pressed, it automatically scans column "G" ( in this case i marked it as column "7") for the key word "CF". For the rows that are marked "CF", it will move those applicable rows down to the next designated row for the next shift. So far it is scanning the whole document (not what i want it to do) for "CF" and it is populating it at the last blank space in the document and not in the required starting row.

The Macro i am currently working with is formulated as such:

Sub Button1_Click()
 
 ' Define the object variables
    Dim sourceWorksheet As Worksheet
    Dim targetWorksheet As Worksheet

    ' Define other variables
    Dim searchString As String

    Dim lastSourceRow As Long
    Dim startSourceRow As Long
    Dim lastTargetRow As Long
    Dim sourceRowCounter As Long
    Dim columnToEval As Long
    Dim columnCounter As Long
   
    Dim columnsToCopy As Variant

    ' Adjust the worksheets names
    Set sourceWorksheet = ThisWorkbook.Worksheets("")
    Set targetWorksheet = ThisWorkbook.Worksheets("")

    ' Define the number of columns to copy from one sheet to the other
    columnsToCopy = Array(1, 3, 4, 9)

    ' Set the string you're going to evaluate
    searchString = "CF"

    ' Adjust the initial row where data is going to be evaluated
    startSourceRow = 14

    ' Adjust the column where you evaluate if condition is met
    columnToEval = 7

    ' Find the number of the last row in source sheet (notice that this search in column A = 1)
    lastSourceRow = sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 1).End(xlUp).row
    
    For sourceRowCounter = startSourceRow To lastSourceRow

        ' Evaluate if criteria is met in column 7
        If sourceWorksheet.Cells(sourceRowCounter, columnToEval).Value = searchString Then

            ' Get last row on target sheet (notice that this search in column A = 1)
            lastTargetRow = targetWorksheet.Cells(targetWorksheet.Rows.Count, 1).End(xlUp).row
            
            For columnCounter = 0 To UBound(columnsToCopy)
            
            ' You don't need to use copy and paste if values is all that you're passing
                targetWorksheet.Cells(lastTargetRow, columnsToCopy(columnCounter)).Offset(1, 0).Value = sourceWorksheet.Cells(sourceRowCounter, columnsToCopy(columnCounter)).Value
            
            Next columnCounter

        End If

    Next sourceRowCounter

    ' If this is necessary...
    sourceWorksheet.Activate

End Sub

I've been messing with this code to make it more specific in the scan, copy and paste command, but to no forward momentum.

I've tried setting the last source row and last target row to be more specific in where i want it to go, but it only copies one row with the word "CF" in row 7 to the designated row and not transcribe all the applicable rows down.

If i could have an easy code to copy and paste and just change the applicable rows for the copy and paste function and assign it to a push button, that would be extremely helpful.

Any help would be greatly appreciated.

Thanks in advance.

V/R

Daniel

0

There are 0 answers