VBA loop through multiple sheets, if value greater =>12 then copy row to combined sheet

[loubdizzy]

hey Guys

I am having issues with my code. Originally (see original code) I would loop through all sheets and combine data in to one. This worked great. Only 1 sheet had headers (data spill).

'Original code
For i = 2 To Sheets.Count
     Set xRg = Sheets(1).UsedRange
     If i > 2 Then
            Set xRg = Sheets(1).Cells(xRg.Rows.Count + 1, 1)
       End If
        Sheets(i).Activate
       ActiveSheet.UsedRange.Copy xRg
    Next

However, the sheet has now changed.

• There are now headers in all the sheets
• The headers are over two rows with merged cells
• There are now more sheets added (some hidden)
• Only values in a new column multiplying E:F =>10 need to be added to the combined sheet

My attempt so far:

• I have set all unwanted sheets to very hidden so that they remain out the way e.g:

   ActiveWorkbook.Sheets("CI").Visible = xlVeryHidden

• I then created the combined sheet and copied and pasted the two header rows from one of the data sheets.
• I then looped through the remaining worksheets and added a formula in columns S to give us the new values to filter on. Because of the merged cells, I just set a range (although id rather it used last row (I couldn't get this to work form A6, due to the merged cells, see code below)
• I now want to loop back through all sheets (excl combined sheet) and .copyentirerow on anything =>10 in col S and no matter what I haver tried I cant get it to work.

'Apply Formula to all sheets 
For Each wSht In Worksheets
        If wSht.Name <> "Combined" Then
        wSht.Range("S6:S200").Formula = "=RC[-14]*RC[-13]"
        End If
    Next wSht

'i tried to filter it when I couldn't look for the value, but this doesn't work
For Each xWs In Worksheets
    If xWs.Name <> "Combined" Then
        xWs.Range("S1").AutoFilter 1, "=>12"
    End If
    Next xWs

I would be really grateful for any help. I have seen copying rows that contain text and one where it was a value greater than 0 but i could get it to work in all sheets.

Thanks

 

[offthelip]

I am not entirely sure I have understood your requirements, but this code cycles through all worksheets and copies any rows ( columns A to R) , where column E value times columns F value is greater than 12 to the next blank row on the combined sheet.

Sub test2()
Dim outarr(1 To 1, 1 To 18) As Variant
Dim wsht As Worksheet
Worksheets("combined").Select
lastout = Cells(Rows.Count, "A").End(xlUp).Row + 1

For Each wsht In Worksheets
    
        If wsht.Name <> "Combined" Then
         lastrow = wsht.Cells(Rows.Count, "A").End(xlUp).Row '
         'pick up data al lthe workhseets
         inarr = wsht.Range(wsht.Cells(1, 1), wsht.Cells(lastrow, 18)) ' I assume you only need column A to R copied
    
         For i = 6 To lastrow
          If inarr(i, 5) * inarr(i, 6) > 12 Then ' check if Column E time Column f is greater than 12
          ' write this row out to combined sheet
           For k = 1 To 18
           outarr(1, k) = inarr(i, k)
           Next k
           Range(Cells(lastout, 1), Cells(lastout, 18)) = outarr
           lastout = lastout + 1
          End If
         Next i
         End If
    Next wsht
End Sub

 

[loubdizzy]

I am not entirely sure I have understood your requirements, but this code cycles through all worksheets and copies any rows ( columns A to R) , where column E value times columns F value is greater than 12 to the next blank row on the combined sheet.

Sub test2()
Dim outarr(1 To 1, 1 To 18) As Variant
Dim wsht As Worksheet
Worksheets("combined").Select
lastout = Cells(Rows.Count, "A").End(xlUp).Row + 1

For Each wsht In Worksheets
   
        If wsht.Name <> "Combined" Then
         lastrow = wsht.Cells(Rows.Count, "A").End(xlUp).Row '
         'pick up data al lthe workhseets
         inarr = wsht.Range(wsht.Cells(1, 1), wsht.Cells(lastrow, 18)) ' I assume you only need column A to R copied
   
         For i = 6 To lastrow
          If inarr(i, 5) * inarr(i, 6) > 12 Then ' check if Column E time Column f is greater than 12
          ' write this row out to combined sheet
           For k = 1 To 18
           outarr(1, k) = inarr(i, k)
           Next k
           Range(Cells(lastout, 1), Cells(lastout, 18)) = outarr
           lastout = lastout + 1
          End If
         Next i
         End If
    Next wsht
End Sub

Thank you so much for this, much tidier to add an array then add the formula for sure. I have had some issues with the code however ... its failing on the [CODE VBA] If inarr(I, 5) * inarr(I, 6) >= 12 Then ' check if Column E time Column f is greater than 12 [/CODE], if i change to a plus instead of multiply it works but is doesn't copy the entire row correctly (with conditional formatting etc and the columns don't align.) Unsure why its doesn't like it... some sheets are blank if that could be causing issues. Also row 4 and 5 are in some cased merged? thats why i couldnt get last row to work previously. Any thoughts would be great.

 

[offthelip]

I have no idea why an addition of two variables works and the multiplication of the two variables fails . I suggest you look at the values of the two variable using debug when it fails
Firstly this code only copies the values, which Is what I thought you needed, it doens't copy an formatting at all. Copying the formatting is going to be very slow, so I would avoid it if possible, it usually much faster to apply the formatting to the combined sheett automatically at the end using vBA . If you really need to copy the formatting then this method using arrays is not the way to do it.
Merged cells are a big problem in excel and in particular when trying to use vBA. The best advice is avoid them if at all possible. Since they usually only used for display purposes often the same results can be achieved with formatting such as "center across selection"
I would suggest that you will have unmerge all cells manually before running the code. Or you are going to have to write special code to get around the problems it is causing.

 

[loubdizzy]

I have no idea why an addition of two variables works and the multiplication of the two variables fails . I suggest you look at the values of the two variable using debug when it fails
Firstly this code only copies the values, which Is what I thought you needed, it doens't copy an formatting at all. Copying the formatting is going to be very slow, so I would avoid it if possible, it usually much faster to apply the formatting to the combined sheett automatically at the end using vBA . If you really need to copy the formatting then this method using arrays is not the way to do it.
Merged cells are a big problem in excel and in particular when trying to use vBA. The best advice is avoid them if at all possible. Since they usually only used for display purposes often the same results can be achieved with formatting such as "center across selection"
I would suggest that you will have unmerge all cells manually before running the code. Or you are going to have to write special code to get around the problems it is causing.

I thought it may be one of the sheets causing the issue but it isnt, it copied data from one sheet less than 12 but not that line, the one above it, but only by + the data ... no sorry i dont mention the conditional formatting. If you think there is too much going on with it i can just sack it off, otherwise im happy to upload a mine dummy sheet, but it sounds like there are now too many acceptance criteria.

I know i was just stepping through with adding formulas etc. but could that be an easier, certainly computationally slower but under the circumstances an easier solution? (if S = >=12 then copy entire row.... to combined sheet then no merge cell or last row issues?