Hi
I have the following code to transfer a selection of data from one worksheet ("All SAP Data") to another worksheet ("M&T Data only").
The "All SAP Data" has over 50k rows and 16 columns of data. Column 14 contains reference codes such as 6050, 6054, 6067, 6155 etc. (there are about 35 reference codes to select from).
I want to loop down each row of data in "All SAP Data" and if that row contains 6050 in column 14, transfer data in that row from columns 5, 7, 9, 10, 11, 12 and 14 to "M&T Data only".
Eventually, I will be wanting to select a number of reference codes, say 6050, 6067, 6155 etc. (up to 10) but for the time being I was testing this only for 6050.
The code I have is:
Option Explicit
Public aDataIn, aDataOut
Public ws1 As Worksheet, ws2 As Worksheet
Sub test()
Dim lRow2 As Long
Dim i As Long
Dim j As Long
Set ws1 = Sheets("M&T Data only")
Set ws2 = Sheets("All SAP Data")
With ws2
lRow2 = .Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
aDataIn = .Range(.Cells(2, 1), .Cells(lRow2, .UsedRange.Columns.Count + .UsedRange.Column)).Value2
End With
Call TEST2
End Sub
Sub TEST2()
Dim i As Long, j As Long
ReDim Preserve aDataOut(LBound(aDataIn, 1) To UBound(aDataIn, 7))
j = 1
For i = LBound(aDataIn, 1) To UBound(aDataIn, 1)
If aDataIn(i, 14) = 6050 Then
aDataOut(j, 1) = aDataIn(i, 5)
aDataOut(j, 2) = aDataIn(i, 7)
aDataOut(j, 3) = aDataIn(i, 9)
aDataOut(j, 4) = aDataIn(i, 10)
aDataOut(j, 5) = aDataIn(i, 11)
aDataOut(j, 6) = aDataIn(i, 12)
aDataOut(j, 7) = aDataIn(i, 14)
j = j + 1
End If
Next i
With ws2
.Range(.Cells(2, 1), .Cells(UBound(aDataOut), 7)).Value2 = Application.WorksheetFunction.Transpose(aDataOut)
End With
End Sub
I get a type Subscript out of range error at this point:
ReDim Preserve aDataOut(LBound(aDataIn, 1) To UBound(aDataIn, 7))
Could someone point out why it's doing that please?
Bookmarks