I have a code that counts the rows in column A and then runs this array formula in the corresponding rows in other columns, I am wondering if it's possible to have the code run +10 more times than the last row.
For example if there are only populated fields in Column A2 and A3, I would like this code to run 12 times from J2-J14 so it takes the last row +10 if this is possible?
Thank you in advance :)
Dim i As Integer
Dim lastRow As Integer
lastRow = Range("A" & Rows.count).End(xlUp).Row
For i = 1 To lastRow
Range("J" & i + 1).FormulaArray = "=IFERROR(INDEX('Z:\Customer Operations\[O.xlsx]S'!$A:$A, SMALL(IF(A2='Z:\Customer Operations\[O.xlsx]S'!$K:$K, ROW('Z:\Customer Operations\[O.xlsx]S'!$A:$A)-MIN(ROW('Z:\Customer Operations\[O.xlsx]S'!$A:$A))+1, """"), ROW(A" & i & "))),"""")"
Range("K" & i + 1).FormulaArray = "=IFERROR(INDEX('Z:\Customer Operations\[O.xlsx]S'!$D:$D, SMALL(IF(A2='Z:\Customer Operations\[O.xlsx]S'!$K:$K, ROW('Z:\Customer Operations\[O.xlsx]S'!$D:$D)-MIN(ROW('Z:\Customer Operations\[O.xlsx]S'!$D:$D))+1, """"), ROW(A" & i & "))),"""")"
Next i
For i = 2 To 50
Range("L" & i).Formula = "=IF(J" & i & "="""","""",SUMIFS(E:E,D:D,J" & i & "))"
Next
Try,
Dim LastRow As Integer
'// ADD 10 to lastrow
LastRow = Range("A" & Rows.Count).End(xlUp).Row + 10
'// formulas
Range("J2:J" & LastRow).FormulaArray = "=IFERROR(INDEX('Z:\Customer Operations\[O.xlsx]S'!$A:$A, SMALL(IF(A2='Z:\Customer Operations\[O.xlsx]S'!$K:$K, ROW('Z:\Customer Operations\[O.xlsx]S'!$A:$A)-MIN(ROW('Z:\Customer Operations\[O.xlsx]S'!$A:$A))+1, """"), ROW(A2))),"""")"
Range("K2:K" & LastRow).FormulaArray = "=IFERROR(INDEX('Z:\Customer Operations\[O.xlsx]S'!$D:$D, SMALL(IF(A2='Z:\Customer Operations\[O.xlsx]S'!$K:$K, ROW('Z:\Customer Operations\[O.xlsx]S'!$A:$A)-MIN(ROW('Z:\Customer Operations\[O.xlsx]S'!$A:$A))+1, """"), ROW(A2))),"""")"
'// formulas
Range("L2:L50").Formula = "=IF(J2="""","""",SUMIFS(E:E,D:D,J2))"
If A2 is fixed then use $A$2 for small function
Related
I have the following data:
The problem I'm trying to solve is that sometimes the Column H (Place) and Column I (Country) switch places (ex: lines 9,10,11). What I would like to do is:
First check if the year is within the last 3 years (I don't need to fix data older than that).
Load a range of values into an array.
Compare if the values in Column H are in the array.
If not, then switch values between columns. I did that by simply copying and pasting.
I'm stuck at this point. Sorry if it's ugly, first time dealing with arrays
The list I load into the array is in one workbook and the data is on another workbook. Does it work or they need to be on the same workbook?
Sub check_data()
Sheets("list").Activate 'this workbook
Dim DirArray As Variant
DirArray = Range("a1:a18").Value 'loads the range into an array
mypath = "//mynetworkpath/" 'sets the path
file = Dir(mypath & "filename.csv") 'indicates name of the file
Workbooks.Open (mypath & file) 'opens the file
Dim lastrow As Long
lastrow = Cells(Rows.Count, 2).End(xlUp).Row 'sorting by year
Range("A2:K" & lastrow).Sort key1:=Range("B2:B" & lastrow), _
order1:=xlDescending, Header:=xlNo
end_year = Format(Now, "yyyy") - 3 ' last 3 years
x = 2 'starts from second row
Do Until Cells(x, 2) = end_year 'cells(row,col)
For y = LBound(DirArray) To UBound(DirArray)
If Sheet1.Cells(x, 8) = DirArray(y) Then
Range("H" & x).Select
Selection.Copy
Range("M" & x).Select
ActiveSheet.Paste
Range("I" & x).Select
Application.CutCopyMode = False
Selection.Copy
Range("H" & x).Select
ActiveSheet.Paste
Range("M" & x).Select
Application.CutCopyMode = False
Selection.Copy
Range("I" & x).Select
ActiveSheet.Paste
Exit For
End If
Next
x = x + 1
Loop
ActiveWorkbook.Save
ActiveWorkbook.Close True
End Sub
Any guidance is helpful!
Thanks
You can leave the list on the worksheet and use match to check the values:
Sub check_data()
Const FPATH As String = "\\mynetworkpath\" 'use Const for fixed values
Dim rngVals As Range, wb As Workbook, lastrow As Long
Dim ws As Worksheet, tmp, file
Set rngVals = ThisWorkbook.Sheets("list").Range("a1:a18") 'your lookup list
file = Dir(FPATH & "filename.csv")
If Len(file) > 0 Then
Set wb = Workbooks.Open(FPATH & file) 'opens the file
Set ws = wb.Worksheets(1)
lastrow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
ws.Range("A2:K" & lastrow).Sort key1:=ws.Range("B2:B" & lastrow), _
order1:=xlDescending, Header:=xlNo
end_year = Year(Now) - 3 ' last 3 years
x = 2 'starts from second row
Do Until Cells(x, 2) = end_year 'cells(row,col)
tmp = ws.Cells(x, 8).Value
'use Match to check the value against the list
m = Application.Match(tmp, rngVals, 0)
If Not IsError(m) Then
'got a match, so swap the values from H and I
ws.Cells(x, 8).Value = ws.Cells(x, 9).Value
ws.Cells(x, 9).Value = tmp
End If
x = x + 1
Loop
wb.Save
wb.Close
End If 'got the file
End Sub
I managed to sync selected data from three sheets into a fourth sheet. But the data doesn't align properly after empty cells beginning with the 14th row.
Now I'm trying to use arrays to align my data better. I have 3 sheets with columns Area, Zone, Employee and 6 numeric columns for each employee.
The data in Area, Zone & Employee is repeating itself in multiple rows so I need to add the numbers for every employee to have the Employee Name displayed only once with added data in other 6 columns.
I don't really have problem with filtering the names and adding data, but I'm not sure how to do it using arrays.
Or if anyone could help me find a mistake in my code that's causing the data to not align properly, I would also appreciate it. Below is my code so far, hopefully it would help.
Private Sub cmd_button1_Click()
Dim WS1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Set WS1 = Sheets("Sheet2")
Set ws2 = Sheets("Distribution")
Set ws3 = Sheets("Sheet3")
Set ws4 = Sheets("Sheet4")
Dim LastRow As Long
Dim R As Long, LR As Long, n As Long
Application.ScreenUpdating = False
'Getting the row number of last cell
LastRow = ws2.Range("A" & Rows.Count).End(xlUp).Row
'Deleting any previous data from destination sheet
ws2.Range("A2:AX10000").ClearContents
For i = 1 To 10
'If value in V column of the row is "" then copy the row to destination sheet
If WS1.Cells(i, "V").Value = "" Then
WS1.Range("E:E").Copy Destination:=ws2.Range("A1")
WS1.Range("F:F").Copy Destination:=ws2.Range("B1")
WS1.Range("G:G").Copy Destination:=ws2.Range("C1")
WS1.Range("A:A").Copy Destination:=ws2.Range("E1")
WS1.Range("O:O").Copy Destination:=ws2.Range("F1")
WS1.Range("P:P").Copy Destination:=ws2.Range("G1")
WS1.Range("R:R").Copy Destination:=ws2.Range("H1")
WS1.Range("S:S").Copy Destination:=ws2.Range("I1")
WS1.Range("Q:Q").Copy Destination:=ws2.Range("J1")
WS1.Range("T:T").Copy Destination:=ws2.Range("K1")
ws3.Range("E:E").Copy Destination:=ws2.Range("L1")
ws3.Range("F:F").Copy Destination:=ws2.Range("M1")
ws3.Range("G:G").Copy Destination:=ws2.Range("N1")
ws3.Range("A:A").Copy Destination:=ws2.Range("O1")
ws3.Range("S:S").Copy Destination:=ws2.Range("P1")
ws3.Range("T:T").Copy Destination:=ws2.Range("Q1")
ws3.Range("V:V").Copy Destination:=ws2.Range("R1")
ws3.Range("W:W").Copy Destination:=ws2.Range("S1")
ws3.Range("X:X").Copy Destination:=ws2.Range("T1")
ws4.Range("F:F").Copy Destination:=ws2.Range("U1")
ws4.Range("G:G").Copy Destination:=ws2.Range("V1")
ws4.Range("H:H").Copy Destination:=ws2.Range("W1")
ws4.Range("A:A").Copy Destination:=ws2.Range("X1")
ws4.Range("L:L").Copy Destination:=ws2.Range("Y1")
ws4.Range("M:M").Copy Destination:=ws2.Range("Z1")
ws4.Range("N:N").Copy Destination:=ws2.Range("AA1")
ws4.Range("O:O").Copy Destination:=ws2.Range("AB1")
ws4.Range("P:P").Copy Destination:=ws2.Range("AC1")
ws4.Range("Q:Q").Copy Destination:=ws2.Range("AD1")
End If
Next i
LR = Cells(Rows.Count, "C").End(xlUp).Row
Range("A2:AX" & LR).Sort Key1:=Range("A2"), Order1:=xlAscending
For R = 2 To LR
'Count the number of duplicates for third row
n = Application.CountIf(Columns(3), Cells(R, 3).Value)
'Sum up the values for every duplicate
Range("F" & R).Value = Evaluate("=Sum(F" & R & ":F" & R + n - 1 & ")")
Range("G" & R).Value = Evaluate("=Sum(G" & R & ":G" & R + n - 1 & ")")
Range("H" & R).Value = Evaluate("=Sum(H" & R & ":H" & R + n - 1 & ")")
Range("I" & R).Value = Evaluate("=Sum(I" & R & ":I" & R + n - 1 & ")")
Range("J" & R).Value = Evaluate("=Sum(J" & R & ":J" & R + n - 1 & ")")
Range("K" & R).Value = Evaluate("=Sum(K" & R & ":K" & R + n - 1 & ")")
Range("E" & R).Value = Evaluate("=Count(E" & R & ":E" & R + n - 1 & ")")
'Go to next value in third column
R = R + n - 1
Next R
On Error Resume Next
'Remove all duplicates
ws2.Range("$A$1:$K$7979").RemoveDuplicates Columns:=3, Header:=xlYes
On Error GoTo 0
'Fill out the table with values
Columns("A:K").AutoFit
Application.ScreenUpdating = True
Range("A1").Select
End Sub
The code above is for synchronizing the sheets with Distribution and filter the data from Sheet2, and I have 2 more buttons made to filter the other 2 sheets.
The code below is my attempt to align the data but it's not working correctly.
Sub LineEmUp()
Dim i As Long, j As Long, LR As Long
Application.ScreenUpdating = False
LR = Range("C" & Rows.Count).End(xlUp).Row
Columns("A:K").Sort Key1:=Range("A2"), _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Columns("L:T").Sort Key1:=Range("L2"), _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Columns("U:AD").Sort Key1:=Range("U2"), _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
i = 2
Do
If Cells(i, "C") > Cells(i, "N") And Cells(i, "C") > "" Then
Cells(i, "A").Resize(1, 10).Insert xlShiftDown
ElseIf Cells(i, "N") > Cells(i, "W") And Cells(i, "N") > "" Then
Cells(i, "L").Resize(1, 10).Insert xlShiftDown
ElseIf Cells(i, "W") > Cells(i, "C") And Cells(i, "W") > "" Then
Cells(i, "U").Resize(1, 10).Insert xlShiftDown
ElseIf Cells(i, "C") < Cells(i, "N") And Cells(i, "C") > "" Then
Cells(i, "L").Resize(1, 10).Insert xlShiftDown
ElseIf Cells(i, "N") < Cells(i, "W") And Cells(i, "N") > "" Then
Cells(i, "U").Resize(1, 10).Insert xlShiftDown
ElseIf Cells(i, "W") < Cells(i, "C") And Cells(i, "W") > "" Then
Cells(i, "A").Resize(1, 10).Insert xlShiftDown
End If
i = i + 1
Loop Until Cells(i, "C") = "" And Cells(i, "W") = ""
Application.ScreenUpdating = True
End Sub
Hope I explained it properly. Thanks
Organization (without unnecessary repetition) is always important in coding, and especially key when troubleshooting. For example, your 29 copy-paste statements can be tidied up considerably - which shows some inconsistencies.
...I sorted them by source worksheet and then by source column, and grouped them together, also pasting into columns instead of single cells.
Edit:
There's a number of "weird things" going on here that require some explanation so I know whether they're designed this way intentionally.
**See my "'<<<<<<" notes below (There are some specific questions, starting with *what happens if you don't disable screen updating, and don't ignore the errors with On Error Resume Next...?
Option Explicit
Private Sub cmd_button1_Click()
Dim WS1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Set WS1 = Sheets("Sheet2")
Set ws2 = Sheets("Distribution")
Set ws3 = Sheets("Sheet3")
Set ws4 = Sheets("Sheet4")
'Dim LastRow As Long
Dim R As Long, LR As Long, n As Long, i As Integer
' <<<<< always ALLOW screen updating during troubleshooting, until your code
' <<<<< is functioning perfectly: It may give a clue to the problem.
'Application.ScreenUpdating = False
'Getting the row number of last cell '<<<<< variable [LastRow] is not being used.
'LastRow = ws2.Range("A" & Rows.Count).End(xlUp).Row
'Deleting any previous data from destination sheet
'ws2.Range("A2:AX10000").ClearContents
ws2.UsedRange.ClearContents ' <<<<<< instead of specifying a range, just clear what's used
For i = 1 To 10
'If value in V column of the row is "" then copy the row to destination sheet
If WS1.Cells(i, "V").Value = "" Then
WS1.Range("A:A").Copy Destination:=ws2.Range("E:E") '<<< there's no pattern to what's being copied,
WS1.Range("E:G").Copy Destination:=ws2.Range("A:C") '<<< (and in a strange criss-cross),
WS1.Range("O:S").Copy Destination:=ws2.Range("F:I") '<<< are you sure nothing's being missed?
WS1.Range("T:T").Copy Destination:=ws2.Range("K:K")
ws3.Range("A:A").Copy Destination:=ws2.Range("O:O")
ws3.Range("E:G").Copy Destination:=ws2.Range("L:N")
ws3.Range("S:T").Copy Destination:=ws2.Range("P:Q")
ws3.Range("V:X").Copy Destination:=ws2.Range("R:T")
ws4.Range("A:A").Copy Destination:=ws2.Range("X1")
ws4.Range("F:H").Copy Destination:=ws2.Range("U:W")
ws4.Range("L:Q").Copy Destination:=ws2.Range("Y:AD")
End If
Next i
LR = Cells(Rows.Count, "C").End(xlUp).Row
Range("A2:AX" & LR).Sort Key1:=Range("A2"), Order1:=xlAscending '<<<<< this could be a problem??
For R = 2 To LR
'Count the number of duplicates for third row
n = Application.CountIf(Columns(3), Cells(R, 3).Value)
'Sum up the values for every duplicate
Range("F" & R).Value = Evaluate("=Sum(F" & R & ":F" & R + n - 1 & ")") '<<<<<< this is a strange way to do this...,
Range("G" & R).Value = Evaluate("=Sum(G" & R & ":G" & R + n - 1 & ")") '<<<<<< can you explain the purpose of these lines?
Range("H" & R).Value = Evaluate("=Sum(H" & R & ":H" & R + n - 1 & ")") '<<<<<< why not just add the cells normally instead like this?
Range("I" & R).Value = Evaluate("=Sum(I" & R & ":I" & R + n - 1 & ")")
Range("J" & R).Value = Evaluate("=Sum(J" & R & ":J" & R + n - 1 & ")")
Range("K" & R).Value = Evaluate("=Sum(K" & R & ":K" & R + n - 1 & ")")
Range("E" & R).Value = Evaluate("=Count(E" & R & ":E" & R + n - 1 & ")")
'Go to next value in third column
R = R + n - 1 '<<<<< WOAH! don't change the value of R when it's being used inside a loop!!!
Next R
'On Error Resume Next '<<<<< Errors mean something - Don't ignore them! (especially during troubleshooting)
'Remove all duplicates
ws2.Range("$A$1:$K$7979").RemoveDuplicates Columns:=3, Header:=xlYes '<<< this shifts cells around, might be a problem
On Error GoTo 0
'Fill out the table with values
Columns("A:K").AutoFit
Application.ScreenUpdating = True
Range("A1").Select
End Sub
This works to put the values in the column:
Sub JR_ArrayToDebugPint2()
' written by Jack in the UK for [url]www.OzGrid.com[/url]
' our web site [url]www.excel-it.com[/url]
' Excel Xp+ 14th Aug 2004
' [url]http://www.ozgrid.com/forum/showthread.php?t=38111[/url]
Dim JR_Values(500)
Dim JR_Count As Integer
Dim R As Long
R = 2
For JR_Count = 1 To 500 Step 1
JR_Values(JR_Count) = Evaluate("=INDEX('Client'!$O$2:$O$347473,MATCH(1,(('Client_Cost'!$D$2:$D$347473=BC" & CStr(R) & ")*('Client_Cost'!$E$2:$E$347473=BE" & CStr(R) & ")),0))")
Sheet1.Range("BG" & CStr(R) & "").Value = JR_Values(JR_Count)
R = R + 1
'Debug.Print JR_Values(JR_Count)
Next JR_Count
End Sub
I've modified the original code I found on mrexcel.com
I get the correct list of values whether I Debug.Print or print to the worksheet. So in my mind, I ought to be able to put the values in an array as they are calculated, then use Range("BG2:BG500").Value = Application.Transpose(myarray).
I am assuming if I do this the values will be placed in the cells in the column all at once, rather than one at a time, which is what this code, and all others I've tried, is doing. I am also assuming that, if the values are placed in the cells in the column all at once, it is MUCH faster than placing the values in the cells one at a time.
What I'm not able to do is get the code to put the value in an array once the formula is evaluated. I've tried variations of the following with no success - statements to set the array and have the array take the value of the calculation are in caps and marked by ==>. The most common error I get is type mismatch.
Sub JR_ArrayToDebugPint2()
Dim JR_Values(500)
Dim JR_Count As Integer
Dim R As Long
==> DIM arrPRICE(0 TO 500) AS VARIANT
R = 2
For JR_Count = 1 To 500 Step 1
JR_Values(JR_Count) = Evaluate("=INDEX('Client'!$O$2:$O$347473,MATCH(1,(('Client_Cost'!$D$2:$D$347473=BC" & CStr(R) & ")*('Client_Cost'!$E$2:$E$347473=BE" & CStr(R) & ")),0))")
==> arrPRICE(R) = JR_VALUES(JR_COUNT)
R = R + 1
'Debug.Print JR_Values(JR_Count)
Next JR_Count
End Sub
When you dimension the variant array like Dim JR_Values(500) you are creating a one-dimensioned array based upon a zero-based index. This first element within the array is JR_Values(0) and the last is JR_Values(500) for a total of 501 array elements. While you could work from 0 to 499 with a little math, you can also force a one-based index on the variant array by declaring it that way.
The assumed worksheet parentage of the BC and BE columns where the individual row data criteria comes from is not definitive when using Application Evaluate like it is when the same formula is used on a worksheet. A worksheet knows who it is; VBA may or may not know what worksheet you are implying.
Sub JR_ArrayToDebugPint2()
Dim olr As Long, rws As Long, JR_Count As Long, JR_Values As Variant
'get some dimensions to the various data ranges
With Worksheets("Client_Cost")
'only use as many rows as absolutely necessary
olr = Application.Min(.Cells(Rows.Count, "C").End(xlUp).Row, _
.Cells(Rows.Count, "E").End(xlUp).Row)
End With
With Worksheets("Client")
rws = Application.Min(.Cells(Rows.Count, "BC").End(xlUp).Row, _
.Cells(Rows.Count, "BE").End(xlUp).Row)
'override the above statement unless you want to run this overnight
rws = 500
End With
ReDim JR_Values(1 To rws) 'force a one-based index on the array
'Debug.Print LBound(JR_Values) & ":" & UBound(JR_Values)
For JR_Count = LBound(JR_Values) To UBound(JR_Values) Step 1
'Debug.Print Evaluate("INDEX('Client'!O2:O" & olr & _
", MATCH(1, (('Client_Cost'!D2:D" & olr & "='Client'!BC" & JR_Count+1 & ")" & _
"*('Client_Cost'!E2:E" & olr & "='Client'!BE" & JR_Count+1 & ")), 0))")
'R would be equal to JR_Count + 1 if R was still used (starts as R = 2)
JR_Values(JR_Count) = _
Evaluate("INDEX('Client'!O2:O" & olr & _
", MATCH(1, (('Client_Cost'!D2:D" & olr & "='Client'!BC" & JR_Count + 1 & ")" & _
"*('Client_Cost'!E2:E" & olr & "='Client'!BE" & JR_Count + 1 & ")), 0))")
'Debug.Print JR_Values(JR_Count)
Next JR_Count
With Worksheets("Client")
.Range("BG2").Resize(UBound(JR_Values), 1) = Application.Transpose(JR_Values)
End With
End Sub
I've left a lot of comments for you to review and subsequently clean up. I recently wrote a narrative of declaring one-dimension and two-dimension variant arrays in How to assign the variable length of an array to integer variable.
I'm looking for a more efficient, less hard-coded way of transposing an array and then autofilling formulas in adjacent columns. Here is my current code for transposing my array in a specific spot on the sheet and autofilling the columns:
If Len(Join(myArray)) > 0 Then
ActiveWorkbook.Sheets("Delta Summary").Range("A3:A" & UBound(myArray) + 2) = WorksheetFunction.Transpose(myArray)
ActiveWorkbook.Sheets("Delta Summary").Range("B3").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.AutoFill Destination:=Range("B3:K17"), Type:=xlFillDefault
Else: End If
The goal is to transpose the array starting in cell A3 on sheet "Delta Summary". My code accomplishes this, but I'm wondering if there's a better way to do it. For reference, I loop through this array and transpose it several times based on different criteria. I transpose the array beginning at cells A3, A20, A37,..., and A224. Each section has 15 cells allocated for data.
As for the auto-fill, I'd like to auto-fill the formulas in columns B:K down to the last populated cell in column A for that pre-defined range (ex. A3:A17, A20:34, etc.). I don't know how to find the last populated cell for a pre-defined range, so I have this hardcoded.
I'm still learning, so any insight would be greatly appreciated!
Edit: Here is one example of the looping criteria I use to populate my array:
ReDim myArray(0)
For i = 1 To LastCurrID
If ActiveWorkbook.Sheets("Weekly Comparison").Range("N" & i) = "N" And ActiveWorkbook.Sheets("Weekly Comparison").Range("J" & i) = "Billing" Then
myArray(UBound(myArray)) = ActiveWorkbook.Sheets("Weekly Comparison").Range("A" & i)
ReDim Preserve myArray(UBound(myArray) + 1)
End If
Next i
Edit #2: For those who are curious, here's the completed code. I only slightly changed what was commented below.
ReDim myArray(0)
For i = 1 To LastCurrID
If wkb.Sheets("Weekly Comparison").Range("N" & i) = "N" And wkb.Sheets("Weekly Comparison").Range("J" & i) = "Billing" Then
myArray(UBound(myArray)) = wkb.Sheets("Weekly Comparison").Range("A" & i)
ReDim Preserve myArray(UBound(myArray) + 1)
End If
Next i
For y = LBound(myArray) To UBound(myArray)
If Len(Join(myArray)) > 0 Then
With wks
.Range("A" & x & ":A" & UBound(myArray) + x - 1) = WorksheetFunction.Transpose(myArray)
Dim lRow As Long
lRow = .Range("A" & x).End(xlDown).Row - x + 1
.Range("B" & x).Resize(1, 10).AutoFill _
Destination:=.Range("B" & x).Resize(lRow, 10), Type:=xlFillDefault
End With
End If
Next
x = x + 17
EDIT (Based on OP Update Question with Looping)
From the way you build your array, it seems like the array is loading with the last row of the data range to be copied (within the 15 row limit) for each range.
The below will loop through the array again, and will set a factor of 17 to x for each loop (starting at 3) and will find the last row within the specified range starting at 'Bx' and uses the .Resize method to do the AutoFill:
'always best to qualify the workbook, worksheet objects with a variable
Dim wkb As Workbook, wks As Worksheet
Set wkb = Workbooks("myWKb")
Set wks = wkb.Sheets("Delta Summary")
Dim x As Long, y As Long
x = 3
For y = LBound(myArray) To UBound(myArray)
If Len(Join(myArray)) > 0 Then
With wks
.Range("A" & x & ":A" & UBound(myArray) + 2) = WorksheetFunction.Transpose(myArray)
Dim lRow As Long
lRow = .Range("A" & x).End(xlDown).Row
.Range("B" & x).Resize(1, 10).AutoFill _
Destination:=.Range("B" & x).Resize(lRow, 10), Type:=xlFillDefault
End With
End If
x = x + 17
Next
I'm new to VBA in excel, I write code for copying cells from sheet to an array. When I run I got run time error. I don't know whats wrong.
Sub DistSystem()
Dim count As Integer
Dim i As Integer
Dim array_rank() As Variant
Dim array_city() As Variant
Dim array_assign() As Variant
count = Sheets("111").Range("Y2").Value
For i = 0 To count
array_city(i) = Range("A" & i).Value
array_rank(i) = Range("E" & i).Value
array_assign(i) = Range("F" & i).Value
Next
For i = 1 To 10
MsgBox array_rank(i, 1)
Next
End Sub
I suspect you are going to be battle errors in multiple places.
This section of code has 2 significant problems
array_city(i) = Range("A" & i).Value
array_rank(i) = Range("E" & i).Value
array_assign(i) = Range("F" & i).Value
First you are trying to assign values to array that do not have any dimensions. You decleared the arrays but you left them dimensionless. You need to define the dimensions before you try to assign values to the array
Something like
Redim array_city(1 to count)
Next you are trying to get a value from Range("A" & i) when the value of i is zero. Cell "A0" does not exists and will also throw an error.
So to rewrite your code as written, you would need to make a few changes:
Sub DistSystem()
Dim count As Integer
Dim i As Integer
Dim array_rank() As Variant
Dim array_city() As Variant
Dim array_assign() As Variant
count = Sheets("111").Range("Y2").Value
Redim array_rank(1 to count)
Redim array_city(1 to count)
Redim array_assign(1 to count)
For i = LBound(array_rank) To UBound(array_rank)
array_city(i) = Range("A" & i).Value
array_rank(i) = Range("E" & i).Value
array_assign(i) = Range("F" & i).Value
Next
For i = 1 To 10
MsgBox array_rank(i)
Next
End Sub
However, you are over complicating how you are reading the values into the array. You can simply read the entire range directly into the array
Sub DistSystem()
Dim count As Integer
Dim i As Integer
Dim array_rank As Variant 'Notice the arrays are not longer declared with ()
Dim array_city As Variant ' -> this is necessary
Dim array_assign As Variant
count = Sheets("111").Range("Y2").Value
array_city = Range("A1:A" & count).Value
array_rank = Range("E1:E" & count).Value
array_assign = Range("F1:F" & count).Value
For i = 1 To 10
MsgBox array_rank(i, 1)
Next
End Sub
The resulting array with be 2 dimensions, with the Row value as the first dimension and the column as the 2nd dimension. since all of the ranges are a single column, you would access any value by calling array_rank(Row,1) or array_city(Row,1) or array_assign(Row,1).