Resizing array dynamically

[Guinaba]

Hi guys,
I have two arrays: Arr1 and Arr2 which is a copy from Arr1 having one extra column, so in my code I ReDim the Arr2 using ReDim Arr2(1 To AD1, 1 To 5).
Is it possible redim the Arr2 dynamically instead of fixing to 5 columns?

Code:

Sub Vlookup()

Dim Arr1() As Variant

Dim AD1 As Long

Dim AD2 As Long

Dim Arr2() As Variant

Dim i As Long

Dim Name As String

Dim Department As String

Dim Lookup_val As String

Dim Salary As Long


Arr1 = Range("A2", Range("A1").End(xlDown).End(xlToRight))


AD1 = UBound(Arr1, 1)

AD2 = UBound(Arr1, 2)


'Populating A2 with data from A1 and concatenating the data

ReDim Arr2(1 To AD1, 1 To 5)


For i = 1 To AD1

Arr2(i, 1) = Arr1(i, 2) & "_" & Arr1(i, 3)

Arr2(i, 2) = Arr1(i, 1)

Arr2(i, 3) = Arr1(i, 2)

Arr2(i, 4) = Arr1(i, 3)

Arr2(i, 5) = Arr1(i, 4)

Next i


Name = InputBox("Enter the name of the Employee")

Department = InputBox("Enter the department of the Employee")

Lookup_val = Name & "_" & Department

Salary = Application.WorksheetFunction.Vlookup(Lookup_val, Arr2, 5, False)

MsgBox ("The salary of the emmployee is " & Salary)


End Sub


Table:

ID	Name	Department	Salary
12201​	Mahesh	IT	25000​
12202​	Rekha	HR	28000​
12203​	Sashi	Marketing	18000​
12204​	Rishabh	Sales	21000​
12205​	Ankush	PR	18000​
12206​	Sashi	IT	32000​
12207​	Rishi	HR	21000​
12208​	Krishna	Marketing	18000​
12209​	Shikha	Sales	18000​
12210​	Rini	Support	32000​
12211​	Vrish	IT	21000​
12212​	Dia	HR	18000​
12213​	Dhruv	Marketing	22000​
12214​	Vishu	Sales	16000​
12215​	Sachin	PR	23000​
12216​	Ashwin	IT	21000​
12217​	Ayush	HR	22000​
12218​	Brijesh	Marketing	18000​
12219​	Dhruv	Sales	32000​
12220​	Abhishek	Production	21000​

 

[gallen]

You can get the last used column and use that instead. I think I've understood.

Check the additional and amended code below.

Sub Vlookup()

Dim Arr1() As Variant

Dim AD1 As Long

Dim AD2 As Long

Dim Arr2() As Variant

Dim i As Long

Dim Name As String

Dim Department As String

Dim Lookup_val As String

Dim Salary As Long

Dim lc As Long 'last column


    Arr1 = Range("A2", Range("A1").End(xlDown).End(xlToRight))
   
   
    AD1 = UBound(Arr1, 1)
   
    AD2 = UBound(Arr1, 2)
   
    'Get last used column on the first row. Change where necessary
    lc = Cells(1, Columns.Count).End(xlToLeft).Column
   
    'Populating A2 with data from A1 and concatenating the data
   
    ReDim Arr2(1 To AD1, 1 To lc)
   
   
    For i = 1 To AD1
   
    Arr2(i, 1) = Arr1(i, 2) & "_" & Arr1(i, 3)
   
    Arr2(i, 2) = Arr1(i, 1)
   
    Arr2(i, 3) = Arr1(i, 2)
   
    Arr2(i, 4) = Arr1(i, 3)
   
    Arr2(i, 5) = Arr1(i, 4)
   
    Next i
   
   
    Name = InputBox("Enter the name of the Employee")
   
    Department = InputBox("Enter the department of the Employee")
   
    Lookup_val = Name & "_" & Department
   
    Salary = Application.WorksheetFunction.Vlookup(Lookup_val, Arr2, 5, False)
   
    MsgBox ("The salary of the emmployee is " & Salary)


End Sub

 

[Fluff]

How about

ReDim arr2(1 To AD1, 1 To AD2 + 1)

 

[Guinaba]

Thanks @gallen and @Fluff ! Thanks workf for me!

 

[Fluff]

Glad we could help & thanks for the feedback