Poundland
08-27-2015, 08:42 AM
All,
After all your gracious help on my last project, I learnt so much and have created a piece of code for a new project.
To cut a long story short, I have 200k data points to check, and on a defined result at each point some data is copied from one sheet to another sheet.
The very first time, this happens it works ok and the data is copied and pasted correctly, unfortunately when it is required to occur a second and third time, and so on, it doesn't work. It certainly doesn't offset.
The lines where I think it does not work are; but I could be wrong...
RngToCopy.Copy Destn
Set Destn = Destn.Offset(RngToCopy.Cells.Count)
The full code is below, if you could glance your genius eyes over it and advise me as to where I am going wrong.
Sub Exception_Selection()
Application.ScreenUpdating = False
Dim Destn As Range, ExSheet As Worksheet, MList As Worksheet, AFRng As Range, AFData As Range, ms As String, cll As Range, RngToCopy As Range
Dim FWk As Range, Extion As Worksheet, PO As Range, POCll As Range, WCov As Range, Tdate As String, DEx As Range
Set Extion = Workbooks("Exceptions Line Monitor").Sheets("Workings")
Set DEx = Extion.Cells(1, 8)
Tdate = Format(Date, "dd.mm.yyyy")
Workbooks.Open ("I:\H914 Development and Supply Chain\AWR\Helen Exceptions Project\Exceptions.xlsx")
Set ExSheet = Sheets.Add
ExSheet.Name = Tdate
Set Destn = ExSheet.Range("a1")
'Set RngToCopy = Workbooks("Orders Outstanding With Multi Master").Sheets("Orders Outstanding With Multi").Range("$A$1:$Ac$1")
'RngToCopy.Copy Destn
'Set Destn = Destn.Offset(RngToCopy.Cells.Count)
Set MList = Workbooks("Exceptions Line Monitor").Sheets("List")
Set AFRng = Intersect(Workbooks("Orders Outstanding With Multi Master").Sheets("Orders Outstanding With Multi").UsedRange, (Workbooks("Orders Outstanding With Multi Master").Sheets("Orders Outstanding With Multi").Range("$A:$Ac")))
Set AFData = AFRng.Resize(AFRng.Rows.Count - 1).Offset(1)
' create loop
For Each cll In MList.Range(MList.Cells(1, 1), MList.Cells(1, 1).End(xlDown)).Cells
Workbooks("Exceptions Line Monitor").Sheets("Workings").Cells(4, 2).Value = cll
' add PO loop
For Each PO In Extion.Range("$o$9:$bb$9")
If PO > 0 Then
'Set POCll = PO.Cells
Set WCov = PO.Cells.Offset(3)
If WCov > DEx Then
Set FWk = PO.Cells.Offset(-7)
AFRng.AutoFilter Field:=29, Criteria1:=FWk
AFRng.AutoFilter Field:=8, Criteria1:=cll
Set RngToCopy = Nothing
On Error Resume Next
Set RngToCopy = AFData.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not RngToCopy Is Nothing Then
RngToCopy.Copy Destn
Set Destn = Destn.Offset(RngToCopy.Cells.Count)
End If
Else
End If
'MsgBox (PO)
Else
End If
Next PO
'MsgBox (cll)
Next cll
AFRng.AutoFilter
Destn.Select
Windows("Exceptions.xlsx").Activate
Application.ScreenUpdating = True
End Sub
After all your gracious help on my last project, I learnt so much and have created a piece of code for a new project.
To cut a long story short, I have 200k data points to check, and on a defined result at each point some data is copied from one sheet to another sheet.
The very first time, this happens it works ok and the data is copied and pasted correctly, unfortunately when it is required to occur a second and third time, and so on, it doesn't work. It certainly doesn't offset.
The lines where I think it does not work are; but I could be wrong...
RngToCopy.Copy Destn
Set Destn = Destn.Offset(RngToCopy.Cells.Count)
The full code is below, if you could glance your genius eyes over it and advise me as to where I am going wrong.
Sub Exception_Selection()
Application.ScreenUpdating = False
Dim Destn As Range, ExSheet As Worksheet, MList As Worksheet, AFRng As Range, AFData As Range, ms As String, cll As Range, RngToCopy As Range
Dim FWk As Range, Extion As Worksheet, PO As Range, POCll As Range, WCov As Range, Tdate As String, DEx As Range
Set Extion = Workbooks("Exceptions Line Monitor").Sheets("Workings")
Set DEx = Extion.Cells(1, 8)
Tdate = Format(Date, "dd.mm.yyyy")
Workbooks.Open ("I:\H914 Development and Supply Chain\AWR\Helen Exceptions Project\Exceptions.xlsx")
Set ExSheet = Sheets.Add
ExSheet.Name = Tdate
Set Destn = ExSheet.Range("a1")
'Set RngToCopy = Workbooks("Orders Outstanding With Multi Master").Sheets("Orders Outstanding With Multi").Range("$A$1:$Ac$1")
'RngToCopy.Copy Destn
'Set Destn = Destn.Offset(RngToCopy.Cells.Count)
Set MList = Workbooks("Exceptions Line Monitor").Sheets("List")
Set AFRng = Intersect(Workbooks("Orders Outstanding With Multi Master").Sheets("Orders Outstanding With Multi").UsedRange, (Workbooks("Orders Outstanding With Multi Master").Sheets("Orders Outstanding With Multi").Range("$A:$Ac")))
Set AFData = AFRng.Resize(AFRng.Rows.Count - 1).Offset(1)
' create loop
For Each cll In MList.Range(MList.Cells(1, 1), MList.Cells(1, 1).End(xlDown)).Cells
Workbooks("Exceptions Line Monitor").Sheets("Workings").Cells(4, 2).Value = cll
' add PO loop
For Each PO In Extion.Range("$o$9:$bb$9")
If PO > 0 Then
'Set POCll = PO.Cells
Set WCov = PO.Cells.Offset(3)
If WCov > DEx Then
Set FWk = PO.Cells.Offset(-7)
AFRng.AutoFilter Field:=29, Criteria1:=FWk
AFRng.AutoFilter Field:=8, Criteria1:=cll
Set RngToCopy = Nothing
On Error Resume Next
Set RngToCopy = AFData.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not RngToCopy Is Nothing Then
RngToCopy.Copy Destn
Set Destn = Destn.Offset(RngToCopy.Cells.Count)
End If
Else
End If
'MsgBox (PO)
Else
End If
Next PO
'MsgBox (cll)
Next cll
AFRng.AutoFilter
Destn.Select
Windows("Exceptions.xlsx").Activate
Application.ScreenUpdating = True
End Sub