subscript out of range with array to filling items are not existed

[Mussa]

Hi
I want matching column BATCH NO(C) for sheet DATA with the same column for FIRST. so every item is missed in column B in FIRST should fill based on is existed in column B for sheet DATA after match items in column C between two sheets .

MATCH.xlsm
	A	B	C	D	E	F
1	ITEM	DEL NO	BATCH NO	ITEM	TT1	QTY
2	1		CC-mm/17	LL-1	RRL	10
3	2		CC-mm/18	LL-2	TTY	2
4	3		CC-mm/19	LL-3	MMW	5
5	4		CC-mm/20	LL-4	NNW	1
6	5		CC-mm/21	LL-5	TRU	10
7	6		CC-mm/13	SS-1	LTR	10
8	7		CC-mm/14	SS-2	FG	20
9	8		CC-mm/15	SS-1	TRR	20
10	9		CC-mm/161	cv3	MNT	20
FIRST

MATCH.xlsm
	A	B	C	D	E
1	ITEM	DEL NO	BATCH NO	ITEM	TT1
2	1	CC-1	CC-mm/12	SS-1	TRU
3	2	CC-2	CC-mm/13	SS-1	LTR
4	3	CC-3	CC-mm/14	SS-2	FG
5	4	CC-4	CC-mm/15	SS-1	TRR
6	5	CC-5	CC-mm/16	SS-1	LTR
7	6	CC-6	CC-mm/17	LL-1	RRL
8	7	CC-7	CC-mm/18	LL-2	TTY
9	8	CC-8	CC-mm/19	LL-3	MMW
10	9	CC-9	CC-mm/20	LL-4	NNW
11	10	CC-10	CC-mm/21	LL-5	TRU
DATA

RESULT IN SHEET FIRST

MATCH.xlsm
	A	B	C	D	E	F
1	ITEM	DEL NO	BATCH NO	ITEM	TT1	QTY
2	1	CC-6	CC-mm/17	LL-1	RRL	10
3	2	CC-7	CC-mm/18	LL-2	TTY	2
4	3	CC-8	CC-mm/19	LL-3	MMW	5
5	4	CC-9	CC-mm/20	LL-4	NNW	1
6	5	CC-10	CC-mm/21	LL-5	TRU	10
7	6	CC-2	CC-mm/13	SS-1	LTR	10
8	7	CC-3	CC-mm/14	SS-2	FG	20
9	8	CC-4	CC-mm/15	SS-1	TRR	20
10	9		CC-mm/161	cv3	MNT	20
FIRST

this is what I have , but gives error subscript out of range

c(n, 2) = a(i, 2)

Sub test2()
    Dim a, b, c, txt As String, temp As String
    Dim i  As Long, ii As Long, n As Long
    a = Sheets("data").Cells(1).CurrentRegion.Value
    b = Sheets("first").Cells(1).CurrentRegion.Value
    c = b: n = 1
    For i = 2 To UBound(a, 1)
        If a(i, 2) = "" Then a(i, 2) = a(i - 2, 1)
        txt = a(i, 3)
      
            If txt = a(i, 3) Then
                n = n + 1
                If temp <> a(i, 2) Then c(n, 2) = a(i, 2): temp = a(i, 2)
               
            End If
       
    Next
       Sheets("first").Cells(1).CurrentRegion.Value = c

End Sub

hope somebody help

 

[Anthony47]

I was not able to correlate your macro to the described task... It looks more a sorting trial than e matching one...
Anyway, if you need to fill Sheets(FIRST) column B with the values picked from Sheet(Data) column B, my first option would be a formula based on Index & Match

If you prefer doing that via macro, try for example this code:

Sub LookUUPP()
Dim DBArea As Range, DDelArea As Range
Dim FRows As Long, DRows As Long
Dim myMatch, I As Long
'
FRows = Sheets("FIRST").Range("A1").CurrentRegion.Rows.Count
DRows = Sheets("DATA").Range("A1").CurrentRegion.Rows.Count
Set DBArea = Sheets("DATA").Range("C1").Resize(DRows, 1)
Set DDelArea = Sheets("DATA").Range("B1").Resize(DRows, 1)
'
With Sheets("FIRST")
    For I = 1 To FRows
        If .Cells(I, 2) = "" Then
            myMatch = Application.Match(.Cells(I, 3), DBArea, False)
            If Not IsError(myMatch) Then
                .Cells(I, 2) = DDelArea.Cells(myMatch, 1)
            End If
        End If
    Next I
End With
End Sub

This will look in Sheets(FIRST)-column B; for each "empty" cell it will then search on Sheets(DATA) the corresponding "Batch No" and pick its DelNo
If column B in FIRST is not Empty then the current value will be kept

If you need a different logic then please explain

 

[Mussa]

Hi Anthony ,
it's great !

If you prefer doing that via macro

of course , but I have question may you add array to your code if the data become big . this can be fast & avoiding slowness when increase data

 

[kvsrinivasamurthy]

Faster method.
Instead of Macro use the formula.
In B2 of FIRST sheet then copy down.

=IFERROR(INDEX(DATA!$B:$B,AGGREGATE(15,6,ROW(DATA!$B$2:$B$11)/(DATA!$C$2:$C$11=$C2),1)),"")

To avoid 0 format cells for Custom #

 

[Mussa]

Instead of Macro use the formula.

thanks but I prefer vba .

 

[Anthony47]

I have question may you add array to your code if the data become big . this can be fast & avoiding slowness when increase data

If your data spans less that a thousand lines using arrays would be useless
Anyway, this works with arrays

Sub LookUpArr()
Dim DBArr, DDelArr, FDelArr, FBArr
Dim DBArea As Range, DDelArea As Range
Dim FRows As Long, DRows As Long
Dim myMatch, I As Long
'
FRows = Sheets("FIRST").Range("A1").CurrentRegion.Rows.Count
DRows = Sheets("DATA").Range("A1").CurrentRegion.Rows.Count
DBArr = Sheets("DATA").Range("C1").Resize(DRows, 1).Value
DDelArr = Sheets("DATA").Range("B1").Resize(DRows, 1).Value
FBArr = Sheets("FIRST").Range("C1").Resize(FRows, 1).Value
FDelArr = Sheets("FIRST").Range("B1").Resize(FRows, 1).Value
'
For I = 1 To FRows
    If FDelArr(I, 1) = "" Then
        myMatch = Application.Match(FBArr(I, 1), DBArr, False)
        If Not IsError(myMatch) Then
            FDelArr(I, 1) = DDelArr(myMatch, 1)
        End If
    End If
Next I
Sheets("FIRST").Range("B1").Resize(UBound(FDelArr), 1) = FDelArr
End Sub

 

[Mussa]

If your data spans less that a thousand lines using arrays would be useless

that's right , but who knows maybe data could be big . so your code will deal with big data .
thanks very much for your assistance

 

[Anthony47]

Thank you for the feedback