sheet names as array variable in VBA

Question

I would like to code a repetitive action in VBA and i need help because i can not simplify the process.

I have the first sheet whose name is all_data and few more whose names are data_530, data531, location_1, location_2, location_3 etc. In the first sheet there are rows which i want to copy in the other sheets based on two conditions. 1. based on the number of column G 2. based on the name of column F So if the number in column G is 530, i want to copy that row to sheet with name "data_530" At the same time, if the location is, let’s say NY, i want to copy that row also to the sheet with name location_1 and so on.

I have already made the coding which works but it is too long (with multiple ifs and many counters) and i want to shorten it since I think It can be done a lot faster.

Here is an example of what I have written

i=1
a=0
a1=0    
a2=0    
a3=0
a4=0
Do While Worksheets("all_data”).Cells(1 + i, 7).Value <> ""
'======================================BASED ON THE NUMBER==================
If Worksheets("all_data”).Cells(1 + i, 7).Value = "530" Then
For l = 1 To noctc
Worksheets(“data_530").Cells(2 + a, l).Value = Worksheets("all_data”).Cells(1 + i, l).Value
Next l
a = a + 1

ElseIf Worksheets("all_data”).Cells(1 + i, 7).Value = "531" Then
For l = 1 To noctc
Worksheets(“data_531").Cells(2 + a1, l).Value =   Worksheets("all_data”).Cells(1 + i, l).Value
Next l
a1 = a1 + 1

ElseIf Worksheets("all_data”).Cells(1 + i, 7).Value = "532" Then
For l = 1 To noctc
Worksheets(“data_532").Cells(2 + a2, l).Value =  Worksheets("all_data”).Cells(1 + i, l).Value
Next l
a2 = a2 + 1
End If

'======================================BASED ON THE LOCATION==================
 If Worksheets("all_data”).Cells(1 + i, 6).Value = "mai_kayl_ep" Then
 For l = 1 To noctc
 Worksheets("mai_kayl_ep").Cells(2 + a3, l).Value =  Worksheets("all_data”).Cells(1 + i, l).Value
 Next l
 a3 = a3 + 1

 ElseIf Worksheets("all_data”).Cells(1 + i, 6).Value = "a_dialogi" Then
 For l = 1 To noctc
 Worksheets("a_dialogi").Cells(2 + a4, l).Value = Worksheets("all_data”).Cells(1 + i, l).Value
 Next l
 a4 = a4 + 1

end so on …. With noctc i indicate the number of column beyond which i do not want to copy the data.

Moreover I tried to use the following

Worksheets("all-_data”).Cells(1 + i, l).copy
        Worksheets("all_530").Cells(2 + a, l).PasteSpecial Paste:=xlPasteFormats
        Worksheets("all_530").Cells(2 + a, l).PasteSpecial Paste:=xlPasteValues

within the for l=1 to noctc loop but it still needs multiple ifs, it takes too long and then VBA crashes.

So what I want to do is to read the first row, specifically the number in column G and the location in column F, and copy the row to the location and number sheet respectively. What is more, I want to copy not only the number/text of the row but also the format. Additionally I want to be able to copy the row until a specific column since beyond that column there other data.

As far as the location is concerned, I want to create a variable (which i think it should be an array) with the name of each sheet (which is actually the location in column F and the number i mentioned above) and to copy the row base on those two conditions without writing one if per location since especially locations are too many and they are expected to increase.

For example I want to write

Dim Location(25)
Location(0) = NY
Location(1) = bbb
Location(3) = ccc

and so on and then use the Location array in a loop

I would appreciate if you help me on that and indicate how to proceed because I don’t know what to do in order to shorten the code. Thanks in advance!!

score 0 · Accepted Answer · answered Feb 27 '18 at 00:22

I can't properly understand your question. For example the difference between columns G and F, since I understand that both are refering to sheet names. Anyway, the code below might help as a start (code do not fulfill all your requirements, since I'm not sure of the details). And forget about noctc: copying an entire row its not a big deal.

Private Sub CopyRows()
Dim curSheet As Worksheet
Dim ArraySheets() As String
Dim x As Variant
Dim TheCellValue As String
Dim i As Long
Dim lLastRow As Long
Dim lLastDestinationRow As Long

'keep sheets names in an array
For Each curSheet In ActiveWorkbook.Worksheets
    ReDim Preserve ArraySheets(x)
    ArraySheets(x) = curSheet.Name
    x = x + 1
Next curSheet

'get the last row of sheet "all_data"
lLastRow = Worksheets("all_data").Cells(Rows.Count, 7).End(xlUp).Row

For i = 1 To lLastRow
    'See the content  of cells in column 7 (G)
    TheCellValue = Worksheets("all_data").Cells(i, 7).Value

    If IsInArray(TheCellValue, ArraySheets) Then 'if the value in column 7 (G) is in the array...
        'get the last used row of destination sheet
        lLastDestinationRow = Worksheets(TheCellValue).Cells(Rows.Count, 1).End(xlUp).Row
        'Copy whole row
        Worksheets("all_data").Rows(i).EntireRow.Copy Worksheets(TheCellValue).Cells(lLastDestinationRow + 1, 1)
    End If
Next i

End Sub


'Funtion by JimmyPena here https://stackoverflow.com/a/11112305/1726522
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

Thank you very much for your help! A final question: How do I copy specific number of columns? I tried this Worksheets("all_data").Row(i).EntireRow.Range("A:L").copy (https://stackoverflow.com/a/36048108/7636500) but it doesn't work. Any suggestion? Thanks again!! — dimic, Feb 28 '18 at 18:18
Replace `Worksheets("all_data").Rows(i).EntireRow.Copy` with `Worksheets("all_data").Range(Cells(i, 1), Cells(i, 12)).Copy` (this will copy first twelve columns, i.e., from A to L). — CMArg, Feb 28 '18 at 18:28

sheet names as array variable in VBA

1 Answers1