Help needed with VBA array code 0
-
Vba (0) 0%
-
Array (0) 0%
Hello
could someone help me with the below VBA code.
What i am trying to do is to store unique identifiers in an array and populate new worksheets by the name of these identifiers and copy data in each unique sheet from the main sheet. The code is given below but it is not working.please could someone help
Code
Sub test()
Dim c As Range
Dim r As Range
Dim wb As Workbook
Dim ws As Worksheet
Dim arr() As String
Set wb = ActiveWorkbook
Set r = wb.Sheets("Data").Range("C2:C16")
ReDim arr(0 To 0)
'Get Unique Values and new sheets
For Each c In r
If Not CheckArray(c.Value, arr) Then
arr(UBound(arr)) = c.Value
ReDim Preserve arr(LBound(arr) To UBound(arr) + 1)
Set ws = wb.Sheets.Add
ws.Name = CStr(c.Value)
End If
c.EntireRow.Copy Sheets(CStr(r.Value)).Cells.SpecialCells(11)(2).EntireRow
ws.Paste ws.Range("A1").SpecialCells(xlLastCell).Offset(1, 0)
Next c
End Sub
Function CheckArray(Value As String, MyArray() As String) As Boolean
Dim i As Integer
For i = LBound(MyArray) To UBound(MyArray)
If MyArray(i) = Value Then
CheckArray = True
Exit Function
End If
Next i
CheckArray = False
End Function
Display More