Mayeb you can tell me why this code isn't working?

[Jameo]

Sub Breaches()
Dim shd, lrow, nrow As Long
Dim sh As Worksheet
shd = 1
lrow = Sheets("breaches").Range("A" & Rows.Count).End(xlUp).Row
nrow = Range("A" & Rows.Count).End(xlUp).Row

    For Each sh In Sheets
        If sh.Name = "DifferenceData" Or sh.Name = "Breaches" Then
        'do nothing
            Else
                Sheets("DifferenceData").Cells(1, shd).Value = sh.Name
                For i = 2 To lrow
                    If sh.Cells(i, 6).Value = "Y" Then
                            sh.Cells(i, 9).Copy
                            ActiveCell = Sheets("breaches").Cells(lrow, shd)
                            ActiveCell.PasteSpecial
                            nrow = nrow + 1
                    End If
 
                Next i
                shd = shd + 1

        End If
    Next sh
End Sub

Basically I have a number of worksheets in my workbook. All worksheets are formatted the same. Column 6 is a Y/N field identifying if a breach has occured. Column 9 is the value fo the breach.

I am attempting to get a macro that will roll through the sheets, determine if the is a breach ("Y) and if so copy the relevent data item, in cell (i,9) and copy the value to a new sheet (breaches) in the correct column and cell.

(there is also a line first to name the cells in the first row after the sheet name)

The destination cell is set by the lrow variable, the first empty cell in the column, witht he column number chosen dependant on the iteration of the sheet with shd. i.e. for the first sheet in the loop it will be 1, then 2, then 3 etc. etc.

I think it is close to working, but I am starting to pull my hair out. Any input will be greatly appreciated.

Cheers

 

[Andrew Poulsom]

Are you trying set set ActiveCell to a Range here?

ActiveCell = Sheets("breaches").Cells(lrow, shd)

If so that won't work. Try changing:

ActiveCell = Sheets("breaches").Cells(lrow, shd)
ActiveCell.PasteSpecial

to:

Sheets("breaches").Cells(lrow, shd).PasteSpecial

 

[MrKowz]

I saw quite a few things wrong:

• Not all variables were properly declared
• You can't set "ActiveCell" in the manner you used (also, there is rarely ever a case needed to use an activecell in code)
• lrow was used to determine the last i to loop for, yet it was based on a different worksheet
• nrow wasn't used at all

Give this adjusted code a shot:

Public Sub Breaches()
Dim sh      As Worksheet, _
    dSh     As Worksheet, _
    shLR    As Long, _
    dLR     As Long, _
    i       As Long, _
    shd     As Long
    
Application.ScreenUpdating = False
    
Set dSh = Sheets("Breaches")
dLR = dSh.Range("A" & Rows.Count).End(xlUp).Row
For Each sh In ActiveWorkbook.Worksheets
    Select Case sh.Name
        Case "DifferenceData", "Breaches"
            'do nothing
        Case Else
            Sheets("DifferenceData").Cells(1, shd).Value = sh.Name
            shLR = sh.Range("A" & Rows.Count).End(xlUp).Row
            For i = 2 To shLR
                If sh.Cells(i, 6).Value = "Y" Then
                    sh.Cells(i, 9).Copy Destination:=dSh.Cells(dLR, shd)
                End If
            Next i
            shd = shd + 1
    End Select
Next sh
Application.ScreenUpdating = True
End Sub

 

[Jameo]

Hi guys,

Thanks for the responses. The poor quality of the code is explained by me making multiple changes as I got more and more annoyed with myself

Appologies for that. I'm going to look through your answers now and will let you know.

Thanks

 

[Jameo]

Sheets("DifferenceData").Cells(1, shd).Value = sh.Name

Gives an application defined, or object defined error MrKowz, any ideas?

Thanks for helping me with this. I definitely need it

I am wondering if the above erro is a resuklt of using the case statements? I never had a problemw ith that specific line previously. It normally all fell apart at:

ActiveCell = Sheets("breaches").Cells(lrow, shd)
ActiveCell.PasteSpecial

Which I had originally changed from

Sheets("breaches").Cells(lrow, shd).PasteSpecial

Just so you both know that I didn't try the active cell line initially. That was my hail mary attempt to make this work

 

[MrKowz]

Sheets("DifferenceData").Cells(1, shd).Value = sh.Name

Gives an application defined, or object defined error MrKowz, any ideas?

Thanks for helping me with this. I definitely need it

shd was never initially declared with a value:

Public Sub Breaches()
Dim sh      As Worksheet, _
    dSh     As Worksheet, _
    shLR    As Long, _
    dLR     As Long, _
    i       As Long, _
    shd     As Long
    
Application.ScreenUpdating = False
    
Set dSh = Sheets("Breaches")
dLR = dSh.Range("A" & Rows.Count).End(xlUp).Row
[COLOR=red][B]shd = 1
[/B][/COLOR]For Each sh In ActiveWorkbook.Worksheets
    Select Case sh.Name
        Case "DifferenceData", "Breaches"
            'do nothing
        Case Else
            Sheets("DifferenceData").Cells(1, shd).Value = sh.Name
            shLR = sh.Range("A" & Rows.Count).End(xlUp).Row
            For i = 2 To shLR
                If sh.Cells(i, 6).Value = "Y" Then
                    sh.Cells(i, 9).Copy Destination:=dSh.Cells(dLR, shd)
                End If
            Next i
            shd = shd + 1
    End Select
Next sh
Application.ScreenUpdating = True
End Sub

 

[Jameo]

Ahh of course.

After changing that, it is half there.

It seems to be putting the values in a row rather than a column, and as I don't have any column headers I would imagine it is over writing the same row time up on time. The macro is taking a while to run so I would also imagine it is going over every sheet. It must just be the column and row identifiers where it is failing.

I'll carry on looking into it. Thanks again MrKowz

Public Sub Breaches()
Dim sh As Worksheet, _
dSh As Worksheet, _
shLR As Long, _
dLR As Long, _
i As Long, _
shd As Long
 
 
shd = 1
Application.ScreenUpdating = False
 
Set dSh = Sheets("Breaches")
dLR = dSh.Range("A" & Rows.Count).End(xlUp).Row
For Each sh In ActiveWorkbook.Worksheets
    Select Case sh.Name
        Case "DifferenceData", "Breaches"
            'do nothing
        Case Else
            Sheets("Breaches").Cells(1, shd).Value = sh.Name
            shLR = sh.Range("A" & Rows.Count).End(xlUp).Row
            For i = 2 To shLR
                If sh.Cells(i, 6).Value = "Y" Then
                    sh.Cells(i, 9).Copy Destination:=dSh.Cells(dLR, shd)
                End If
            Next i
            shd = shd + 1
    End Select
Next sh
Application.ScreenUpdating = True
End Sub

Sheets("difference").Cells(1, shd).Value = sh.Name
should have been
Sheets("Breaches").Cells(1, shd).Value = sh.Name

After changing that it is only populating the column headers again and ntohing else.

 

[MrKowz]

Ahh of course.

After changing that, it is half there.

It seems to be putting the values in a row rather than a column, and as I don't have any column headers I would imagine it is over writing the same row time up on time. The macro is taking a while to run so I would also imagine it is going over every sheet. It must just be the column and row identifiers where it is failing.
-------------------
Sheets("difference").Cells(1, shd).Value = sh.Name
should have been
Sheets("Breaches").Cells(1, shd).Value = sh.Name

After changing that it is only populating the column headers again and ntohing else.

Ahh, that's where I was a bit confused. Now I believe I understand your requirements a bit better:

Public Sub Breaches()
Dim sh      As Worksheet, _
    dSh     As Worksheet, _
    shLR    As Long, _
    i       As Long, _
    shd     As Long, _
    dRow    As Long
    
Application.ScreenUpdating = False
    
Set dSh = Sheets("Breaches")
shd = 1
For Each sh In ActiveWorkbook.Worksheets
    dRow = 2
    Select Case sh.Name
        Case "DifferenceData", "Breaches"
            'do nothing
        Case Else
            dSh.Cells(1, shd).Value = sh.Name
            shLR = sh.Range("A" & Rows.Count).End(xlUp).Row
            For i = 2 To shLR
                If sh.Cells(i, 6).Value = "Y" Then
                    sh.Cells(i, 9).Copy Destination:=dSh.Cells(dRow, shd)
                    dRow = dRow + 1
                End If
            Next i
            shd = shd + 1
    End Select
Next sh
Application.ScreenUpdating = True
End Sub

 

[Jameo]

Ahh your a very clever man mate, especially with all my fumblings regarding this.

Thanks very much for you help, it is now working perfectly.

All the best

 

[MrKowz]

Ahh your a very clever man mate, especially with all my fumblings regarding this.

Thanks very much for you help, it is now working perfectly.

All the best

Not a problem, thank you for the feedback.