Change VBA Coding to allow command to happen if certain cells contain any data

0
votes

I need help figuring out the right verbiage for the VBA Coding that I have in my excel workbook. Currently I have the entire row copying to another sheet when pressing a button if a specific cell contains the word "Fail". I am wanting to change that to the next cell over on the pages to move the entire row if containing any words no matter whether the previous cell says "Pass" or "Fail".

Here is what my coding is so far:

a = Worksheets("Extinguisher").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

If Worksheets("Extinguisher").Cells(i, 10).Value = "Fail" Then
    
    Worksheets("Extinguisher").Rows(i).Copy
    Worksheets("Repairs Sheet").Activate
    b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("Extinguisher").Activate
    
End If

So I need it to change to cell(i, 12) instead of cell(i, 10) and I would like that stated cell now to be able to copy the row like I have it doing below if it contains any value, but not copy other rows that contain no data in cell(i, 12).

Hopefully this makes sense as to what I'm looking to do.

So since posting I have found the solution in my VBA coding see below, but new problem has started. I want the VBA code to look at cells(i, 12) only after row 22 on the specified sheet. I've tried using "FirstRow22" but that makes it so the VBA code does nothing.

a = Worksheets("Extinguisher").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

If Worksheets("Extinguisher").Cells(i, 12).Value > "" Then
    
    Worksheets("Extinguisher").Rows(i).Copy
    Worksheets("Repairs Sheet").Activate
    b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("Extinguisher").Activate
    
End If

I feel like I may just be missing a line of code before this part:

If Worksheets("Extinguisher").Cells(i, 12).Value > "" Then

Please help. Thanks :)

THIS ADDITION IS TO THE COMMENTS BELOW BY FANEDURU:

Here is the entire code now with your changes. I receive a 'Run-Time Error' depending on how many rows are being copied.

Private Sub CommandButton1_Click()

'unprotect sheet Worksheets("Repairs Sheet").Unprotect Password:="JODA"

a = Worksheets("Extinguisher").Cells(Rows.Count, 1).End(xlUp).Row

For i = 21 To a

If Worksheets("Extinguisher").Cells(i, 12).Value <> "" Then
    
    Worksheets("Extinguisher").Rows(i).Copy
    Worksheets("Repairs Sheet").Activate
    b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("Extinguisher").Activate
    
End If

Next a = Worksheets("Extinguisher pg2").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

If Worksheets("Extinguisher pg2").Cells(i, 12).Value <> "" Then
    
    Worksheets("Extinguisher pg2").Rows(i).Copy
    Worksheets("Repairs Sheet").Activate
    b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("Extinguisher pg2").Activate
    
End If

Next a = Worksheets("Extinguisher pg3").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

If Worksheets("Extinguisher pg3").Cells(i, 12).Value = "" Then
    
    Worksheets("Extinguisher pg3").Rows(i).Copy
    Worksheets("Repairs Sheet").Activate
    b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("Extinguisher pg3").Activate
    
End If

Next a = Worksheets("Extinguisher pg4").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

If Worksheets("Extinguisher pg4").Cells(i, 12).Value <> "" Then
    
    Worksheets("Extinguisher pg4").Rows(i).Copy
    Worksheets("Repairs Sheet").Activate
    b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("Extinguisher pg4").Activate
    
End If

Next a = Worksheets("Extinguisher pg5").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

If Worksheets("Extinguisher pg5").Cells(i, 12).Value <> "" Then
    
    Worksheets("Extinguisher pg5").Rows(i).Copy
    Worksheets("Repairs Sheet").Activate
    b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("Extinguisher pg5").Activate
    
End If

Next a = Worksheets("Extinguisher pg 6").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

If Worksheets("Extinguisher pg 6").Cells(i, 12).Value <> "" Then
    
    Worksheets("Extinguisher pg 6").Rows(i).Copy
    Worksheets("Repairs Sheet").Activate
    b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("Extinguisher pg 6").Activate
    
End If

Next a = Worksheets("E-Lights").Cells(Rows.Count, 1).End(xlUp).Row

For i = 21 To a

If Worksheets("E-Lights").Cells(i, 12).Value <> "" Then
    
    Worksheets("E-Lights").Rows(i).Copy
    Worksheets("Repairs Sheet").Activate
    b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("E-Lights").Activate
    
End If

Next a = Worksheets("E Lights pg2").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

If Worksheets("E Lights pg2").Cells(i, 11).Value <> "" Then
    
    Worksheets("E Lights pg2").Rows(i).Copy
    Worksheets("Repairs Sheet").Activate
    b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("E Lights pg2").Activate
    
End If

Next a = Worksheets("E-Lights pg3").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

If Worksheets("E-Lights pg3").Cells(i, 11).Value <> "" Then
    
    Worksheets("E-Lights pg3").Rows(i).Copy
    Worksheets("Repairs Sheet").Activate
    b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("E-Lights pg3").Activate
    
End If

Next a = Worksheets("E Lights pg4").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

If Worksheets("E Lights pg4").Cells(i, 11).Value <> "" Then
    
    Worksheets("E Lights pg4").Rows(i).Copy
    Worksheets("Repairs Sheet").Activate
    b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("E Lights pg4").Activate
    
End If

Next a = Worksheets("E Lights pg5").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

If Worksheets("E Lights pg5").Cells(i, 11).Value <> "" Then
    
    Worksheets("E Lights pg5").Rows(i).Copy
    Worksheets("Repairs Sheet").Activate
    b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("E Lights pg5").Activate
    
End If

Next a = Worksheets("E Lights pg6").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

If Worksheets("E Lights pg6").Cells(i, 11).Value <> "" Then
    
    Worksheets("E Lights pg6").Rows(i).Copy
    Worksheets("Repairs Sheet").Activate
    b = Worksheets("Repairs Sheet").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Repairs Sheet").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("E Lights pg6").Activate
    
End If

Worksheets("Repairs Sheet").Range("A1:N300").Locked = True

'protect the sheet back Worksheets("Repairs Sheet").Protect Password:="JODA"

Next Application.CutCopyMode = False

End Sub

Again the run time error seems to change where it comes out at based on how many rows I am asking the coding to copy to the "Repair Sheet"

1
excelvbatextcopyrow
So, do you want iterating between 22 to the last cell (of A:A column) and copy the row if any value is found in column 12 (L:L). Is this understanding correct? If yes, do you need to also copy the row format? If not, I can show you a much faster way, able to deal with large ranges in seconds. – FaneDuru
Please, do not post code in a comment. You have to edit your question and place there any clarification you need to make. Even a new code version. – FaneDuru
Thank you FaneDuru. I have edited my question with the new coding. I don't think I want what your first comment was. I fixed the coding to do what I asked originally but on my sheet it's now copying information above that I don't want it to. When looking at the excel sheet I would like the VBA to begin to run at row 22 – Chassee Shobe
After re-reading your first comment, I don't really care if it copies the row format. I might be interested in a faster way, but I am running this code over 12 different sheets one at a time, so I don't know if that will make a difference for your suggestion. – Chassee Shobe
I am not sure I understand what you want, if my supposition is wrong. I would suggest that line If Worksheets("Extinguisher").Cells(i, 12).Value > "" Then should be transformed in If Worksheets("Extinguisher").Cells(i, 12).Value <> "" Then (not equal with nothing) and starting iteration from row 22 is solved writing For i = 22 To a. But this reflects my initial supposition which has been considered as wrong... – FaneDuru

1 Answers

0
votes

Please, try the next code. You should appropriately fill the string to make the sheets to be processed array (arrSheets):

Sub copyRowFromManySheets()
 Dim shE As Worksheet, shR As Worksheet, lastRE As Long, firstRE As Long, mtch
 Dim lastRR As Long, lastCol As Long, arrE, i As Long, rngCopy As Range, arrSheets
 
 arrSheets = Split("Extinguisher,SheetX,SheetY,SheetZ,SheetETC", ",") 'place here the names of your sheets to be processed

 Set shR = Worksheets("Repairs Sheet")
 firstRE = 22 'the row where the iteration must start
 
 For Each shE In ActiveWorkbook.Sheets                'iterate between all sheets
    mtch = Application.match(shE.Name, arrSheets, 0)  'find the iteration sheet in the sheets array
    If Not IsError(mtch) Then                         'if it exists in the array:
        lastRE = shE.cells(rows.count, 1).End(xlUp).row 'calculate last row
        lastCol = shE.UsedRange.rows.count              'calculate last col
        
        arrE = shE.Range(shE.cells(firstRE, 1), shE.cells(lastRE, lastCol)).value 'place the range to be processed in an array (to wark faster)
                
        For i = 1 To UBound(arrE)                        'iterate between the array elements
           If arrE(i, 12) <> "" Then                     'if column 12 row value is not nothing
               If rngCopy Is Nothing Then                'if the range to be copied has not been Set
                   Set rngCopy = shE.Range(shE.cells(i, 1), shE.cells(i, lastCol))
               Else
                   Set rngCopy = Union(rngCopy, shE.Range(shE.cells(i, 1), shE.cells(i, lastCol))) 'make a union between the existing range and the new row
               End If
           End If
        Next i
        If Not rngCopy Is Nothing Then                      'if the range to be copied is Set
            lastRR = shR.cells(rows.count, 1).End(xlUp).row 'calculate the target last row
            'copy all the range at once (much faster then copying of each row) and make the variable Nothing
            rngCopy.Copy Destination:=shR.cells(lastRR + 1, 1): Set rngCopy = Nothing
        End If
    End If
 Next shE
End Sub