I think this is more of an issue with excel options and stuff but I'm not sure. A description of my code: It takes time series data written in the first 8-9 tabs in a worksheet (each tab is a different indicator), and displays it in a row so that instead of data being written like in a time series format (1-1-2000 to 1-1-2015 for each indicator) all indicators (with three lags as well as 7 forward lags for the GGR tab) are written for a given date in a row Here is my code:
Sub stuff()
Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5 As Range, rng6 As Range, rng7 As Range, rng8 As Range
Dim datenum As Long, Row As Integer, sorteddate As Variant, loc As Integer
Row = 2
For j = 2 To 53
For i = 8 To 275
If Not (IsEmpty(Cells(i, j).Value)) Then
Sheets("Sheet1").Cells(Row, 8) = Sheets("GGR").Cells(i - 1, j).Value
Sheets("Sheet1").Cells(Row, 9) = Sheets("GGR").Cells(i - 2, j).Value
Sheets("Sheet1").Cells(Row, 10) = Sheets("GGR").Cells(i - 3, j).Value
Sheets("Sheet1").Cells(Row, 29) = Sheets("GGR").Cells(i, j).Value
Sheets("Sheet1").Cells(Row, 30) = Sheets("GGR").Cells(i + 1, j).Value
Sheets("Sheet1").Cells(Row, 31) = Sheets("GGR").Cells(i + 2, j).Value
Sheets("Sheet1").Cells(Row, 32) = Sheets("GGR").Cells(i + 3, j).Value
Sheets("Sheet1").Cells(Row, 33) = Sheets("GGR").Cells(i + 4, j).Value
Sheets("Sheet1").Cells(Row, 34) = Sheets("GGR").Cells(i + 5, j).Value
Sheets("Sheet1").Cells(Row, 35) = Sheets("GGR").Cells(i + 6, j).Value
Sheets("Sheet1").Cells(Row, 36) = Sheets("GGR").Cells(i + 7, j).Value
datenum = Sheets("GGR").Cells(i, 1).Value
Sheets("Sheet1").Cells(Row, 1).Value = datenum
Set rng1 = Sheets("CPIC").Range("A1:A408")
sorteddate = rng1.Value
loc = BinarySearch(rng1, datenum)
Sheets("Sheet1").Cells(Row, 2) = Sheets("CPIC").Cells(loc, j).Value
Sheets("Sheet1").Cells(Row, 3) = Sheets("CPIC").Cells(loc - 1, j).Value
Sheets("Sheet1").Cells(Row, 4) = Sheets("CPIC").Cells(loc - 2, j).Value
Set rng2 = Sheets("GBGT").Range("A1:A71")
sorteddate = rng2.Value
loc = BinarySearch(rng2, datenum)
Sheets("Sheet1").Cells(Row, 5) = Sheets("GBGT").Cells(loc, j).Value
Sheets("Sheet1").Cells(Row, 6) = Sheets("GBGT").Cells(loc - 1, j).Value
Sheets("Sheet1").Cells(Row, 7) = Sheets("GBGT").Cells(loc - 2, j).Value
Set rng3 = Sheets("GFCF").Range("A5:A264")
sorteddate = rng3.Value
loc = BinarySearch(rng3, datenum)
Sheets("Sheet1").Cells(Row, 11) = Sheets("GFCF").Cells(loc, j).Value
Sheets("testsheet").Cells(1, 1).Value = loc
Sheets("Sheet1").Cells(Row, 12).Value = Sheets("GFCF").Cells(loc - 1, j).Value
Sheets("Sheet1").Cells(Row, 13).Value = Sheets("GFCF").Cells(loc - 2, j).Value
Set rng4 = Sheets("M1").Range("A1:A700")
sorteddate = rng4.Value
loc = BinarySearch(rng4, datenum)
Sheets("Sheet1").Cells(Row, 14) = Sheets("M1").Cells(loc, j).Value
Sheets("Sheet1").Cells(Row, 15) = Sheets("M1").Cells(loc - 1, j).Value
Sheets("Sheet1").Cells(Row, 16) = Sheets("M1").Cells(loc - 2, j).Value
Set rng5 = Sheets("M2").Range("A1:A676")
sorteddate = rng5.Value
loc = BinarySearch(rng5, datenum)
Sheets("Sheet1").Cells(Row, 17) = Sheets("M2").Cells(loc, j).Value
Sheets("Sheet1").Cells(Row, 18) = Sheets("M2").Cells(loc - 1, j).Value
Sheets("Sheet1").Cells(Row, 19) = Sheets("M2").Cells(loc - 2, j).Value
Set rng6 = Sheets("CSP").Range("A1:A264")
sorteddate = rng6.Value
loc = BinarySearch(rng6, datenum)
Sheets("Sheet1").Cells(Row, 20) = Sheets("CSP").Cells(loc, j).Value
Sheets("Sheet1").Cells(Row, 21) = Sheets("CSP").Cells(loc - 1, j).Value
Sheets("Sheet1").Cells(Row, 22) = Sheets("CSP").Cells(loc - 2, j).Value
Set rng7 = Sheets("UNR").Range("A1:A272")
sorteddate = rng7.Value
loc = BinarySearch(rng7, datenum)
Sheets("Sheet1").Cells(Row, 23) = Sheets("UNR").Cells(loc, j).Value
Sheets("Sheet1").Cells(Row, 24) = Sheets("UNR").Cells(loc - 1, j).Value
Sheets("Sheet1").Cells(Row, 25) = Sheets("UNR").Cells(loc - 2, j).Value
Set rng8 = Sheets("MKT").Range("A1:A223")
sorteddate = rng8.Value
loc = BinarySearch(rng8, datenum)
Sheets("Sheet1").Cells(Row, 26) = Sheets("MKT").Cells(loc, j).Value
Sheets("Sheet1").Cells(Row, 27) = Sheets("MKT").Cells(loc - 1, j).Value
Sheets("Sheet1").Cells(Row, 28) = Sheets("MKT").Cells(loc - 2, j).Value
Row = Row + 1
End If
Next i
Next j
End Sub
Function BinarySearch(rng As Range, searchValue As Long) As Integer
'dimension these as long to avoid possible integer
'overflow errors for large lists
Dim curIndex As Long
Dim firstIndex As Integer
Dim lastIndex As Integer
Dim nextMiddle As Long
Dim strValue As Long
Dim MyCell As Variant
Dim i As Integer
i = 0
For Each MyCell In rng
If MyCell < searchValue Then
i = i + 1
End If
Next MyCell
BinarySearch = i
End Function
I understand my code is not the most efficient, I was coding quickly and am not the most knowledgeable in VBA. I also tried binary search instead of linear search but I kept on getting bugs so I just used linear search as speed wasn't an issue. Anyway, when I try to run my code, once in a while (ie every 20 tries) it runs and gives an error. The error isn't what I'm concerned about. However when I usually run it it doesn't run. It takes me about 30 minutes to get the debugger to show me a runtime error. When I press the run button on VBA, usually it just exits. I tried step through, and it highlights the first line (sub stuff()) and then the code exits without going through the rest of the code. I already tried allowing macros in excel. I have run other code simple 1 line print statements and that works. I also tried copy and pasting it into a different excel and that made no difference.
I would agree with Jeeped on this line:
If Not (IsEmpty(Cells(i, j).Value)) Then
You should reference the sheet the Cells reference in referring to. Otherwise Excel defaults to the active sheet so if you toggle between sheets the reference won't work as intended.
Yes I figured it out or at least figured a workaround. For some reason my code won't run when the active sheet is "Sheet1". When I make the active sheet "MKT" it works for some reason. Now there are still bugs with linear search returning zero as someone mentioned, although it shouldn't because the values it is searching through all are dates and I buffered all the initial strings with zeros, but that is a bug I can deal with. Thanks for everyone's help,
Cameron
Related
Private Sub CommandButton1_Click()
Dim nbp As Long
Dim i As Long
Dim p As Long
Dim FV As Variant
Dim CS As Variant
Dim K As Variant
Dim iFV As Integer
Dim iCS As Double
If Range("B9") = "Semi-Annual" Then
p = DateDiff("yyyy", Cells(4, 3), Cells(5, 3))
nbp = p * 2
For i = 5 To nbp + 4
Cells(5, 10).Value = Cells(4, 3).Value
Cells(i + 1, 10).Value = DateAdd("m", 6, Cells(i, 10).Value)
Next i
For i = 6 To nbp + 5
Cells(i, 14).Value = Cells(7, 2).Value * (Cells(8, 2).Value / 2)
Next i
FV = Sheet2.Range("J5:J10").Value
CS = Sheet3.Range("F1:G8000").Value
For iFV = 1 To UBound(FV)
For iCS = 1 To UBound(CS, 2)
If FV(iFV, 1) = CS(iCS, 1) Then
K(iFV, 1) = CS(iCS, 2)
End If
Next
Next
Sheet2.Range("K5:K10").Value = K
End If
End If
If Range("B9") = "Annual" Then
nbp = DateDiff("yyyy", Cells(4, 3), Cells(5, 3))
For i = 5 To nbp + 4
Cells(5, 10).Value = Cells(4, 3).Value
Cells(i + 1, 10).Value = DateAdd("m", 12, Cells(i, 10).Value)
Next i
End if
If Range("B9") = "Quarterly" Then
p = DateDiff("yyyy", Cells(4, 3), Cells(5, 3))
nbp = p * 4
For i = 5 To nbp + 4
Cells(5, 10).Value = Cells(4, 3).Value
Cells(i + 1, 10).Value = DateAdd("m", 3, Cells(i, 10).Value)
Next i
End If
If Range("B9") = "Monthly" Then ' to choose from a list .
p = DateDiff("yyyy", Cells(4, 3), Cells(5, 3))
nbp = p * 12
For i = 5 To nbp + 4
Cells(5, 10).Value = Cells(4, 3).Value
Cells(i + 1, 10).Value = DateAdd("m", 3, Cells(i, 10).Value)
Next i
End If
End Sub
I have added all the code in the button to help. i am not sure if that will help, anyway here is it. if the user chooses semi annual then couple of things take place. Same goes for the rest "ifs" but i need to fix this issue first then move on to the rest. the code to too long, it is simple and not complicated.
Now that more of the code is posted, I think I understand what the problem is.
Wherever you reference Cells() VBA assumes it applies to ActiveSheet. And I think you should fully qualify the calls to be Sheet2.Cells() for example or whatever you need.
When you call the code behind a button, the button resides on a sheet and it references the cells on that sheet. But when you moved the code to a module it no longer referenced the sheet with the button, but whatever other sheet was active at the time.
So whenever you see Cells() or Range() without a worksheet specification in front of it, change it so that it you target a specific worksheet.
PS. Avoid using Integer and prefer Long instead. Also, prefer relative referencing such as Sheet2.Range("G2").Cells(i,j) instead of absolute referencing Sheet2.Cells(1+i, 6+j) or string math such as Sheet2.Range("G" & 1+i & ":G" & 5+i).
What is wrong with this code? When run it returns good values but their formatting is bad - values are stored as text
For i = 2 To nrow
For j = 2 To ncol
With Worksheets(j - 1)
Set rang= .Range("A:F")
End With
Dim wart As Variant
wart = Application.VLookup(Cells(i, 1), rang, 6, False)
Cells(i, j) = wart
If IsError(Cells(i, j)) Then Cells(i, j) = 0
Cells(i, j) = Format(Cells(i, j), "Percent")
When data type of wart is changed to Double - "type mismatch" error appears
Formatting was done wrong!
Format(Cells(i, j), "Percent") doesn't seem right
Replace Cells(i, j) = Format(Cells(i, j), "Percent") with Cells(i, j).NumberFormat= "0.00%"
Also make sure you set the value if the cell by Cells(i, j).Value = wart.
I have a function that checks the rows underneath the current one depending on the unique ID. There can be up to 6 unique ideas under the current record (loop variable = i) that match the current record being checked in the loop. After this is done, the records underneath are checked for specific conditions (loop variable x). However, for some reason, I'm running into several issues. The first is that I had to set the range references inside of both loops, otherwise I got an error. The second is that, all of the stuff after the x loop seems to be outputting in the i loop that came before it. What am I doing wrong, and how can i make this function properly?
Please find my code below:
Function First_check()
dim i as long, x as long
Dim numComponents As Variant
Dim in1 As Range, in2 As Range, in3 As Range, in4 As Range, in5 As Range, _
in6 As Range, in7 As Range, in8 As Range, in9 As Range, in10 As Range, _
in11 As Range, in12 As Range, in13 As Range, in14 As Range, in15 As Range, _
in16 As Range, in17 As Range, in18 As Range, in19 As Range, in20 As Range
Dim out1 As Range, out2 As Range, out3 As Range, out4 As Range, out5 As Range, _
out6 As Range, out7 As Range, out8 As Range, out9 As Range, out10 As Range, _
out11 As Range, out12 As Range, out13 As Range, out14 As Range, out15 As Range, _
out16 As Range, out17 As Range, out18 As Range, out19 As Range, out20 As Range
Dim str, msg, oft, BTG, LOB, pdf, mht, emails, zip_rar, xls, doc, xls_doc, mrTT, lobVal, cmt1, giveURL, giveURLm As String
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To lastRow
If Cells(i, 5).Value2 = Cells(i + 6, 5).Value2 Then
numComponents = 6
ElseIf Cells(i, 5).Value2 = Cells(i + 5, 5).Value2 Then
numComponents = 5
ElseIf Cells(i, 5).Value2 = Cells(i + 4, 5).Value2 Then
numComponents = 4
ElseIf Cells(i, 5).Value2 = Cells(i + 3, 5).Value2 Then
numComponents = 3
ElseIf Cells(i, 5).Value2 = Cells(i + 2, 5).Value2 Then
numComponents = 2
ElseIf Cells(i, 5).Value2 = Cells(i + 1, 5).Value2 Then
numComponents = 1
Else
numComponents = 0
End If
For x = i + 1 To i + numComponents
Set in1 = Cells(i, 11) 'test
Set in2 = Cells(i, 12)
Set in3 = Cells(i, 13)
Set in4 = Cells(i, 16) 'e
Set in5 = Cells(i, 37) 'target date
Set in6 = Cells(i, 38) 'target date end
Set in7 = Cells(i, 35) 'target date actual
Set in8 = Cells(i, 37) 'target date start
Set in9 = Cells(i, 38) 'target date end
Set in10 = Cells(x, 50) ' date start
Set in11 = Cells(x, 51) ' date end
Set in12 = Cells(i, 42) 'pro
Set in13 = Cells(i, 43) 'reco
Set in14 = Cells(x, 62) 'cert
Set in15 = Cells(x, 63) 'com
Set in16 = Cells(x, 64) 'comp
Set in17 = Cells(x, 49) 'uniqueID
'outs
Set out1 = Cells(i, 72) 'test
Set out2 = Cells(i, 73) '
Set out3 = Cells(i, 74) '
Set out4 = Cells(i, 75) 'e
Set out5 = Cells(i, 76) 'tar
Set out6 = Cells(i, 77) 'comp
Set out7 = Cells(i, 78) 'pro
Set out8 = Cells(i, 75) 'empty
Set out9 = Cells(i, 80) 'cer
Set out10 = Cells(i, 81) 'comp
Set out11 = Cells(i, 85) 'pre
Set out12 = Cells(i, 88) 'missing
Set out13 = Cells(i, 89) 'missing2
Set out14 = Cells(i, 71) 'uniqueID
'------ATTACHMENT SET
str = Cells(i, 46).Value2
msg = UBound(Split(str, ".msg"))
oft = UBound(Split(str, ".oft"))
BTG = UBound(Split(str, "BTG"))
LOB = UBound(Split(str, "LOB"))
pdf = UBound(Split(str, ".pdf"))
mht = UBound(Split(str, ".mht"))
emails = msg + oft + pdf + mht
zip_rar = UBound(Split(str, ".zip"))
xls = UBound(Split(str, ".xls"))
doc = UBound(Split(str, ".doc"))
xls_doc = xls Or doc
If (in8.Value2 <> in10.Value2) Or (in9.Value <> in11.Value2) Then 'date
out6.Value2 = Cells(x, 49).Value2 & ", " & out6.Value2
End If
If IsBlank(in14.Value2) Then 'Check cer
out9.Value2 = Cells(x, 49).Value2 & ", " & out9.Value2
End If
If IsBlank(in15.Value2) Or IsBlank(in16.Value2) Then 'check loc
out10.Value2 = Cells(x, 49).Value2 & ", " & out10.Value2
End If
If Not IsBlank(in17.Value2) Then
out14.Value2 = in17.Value2 & ", " & out14.Value2
End If
Next x
If Not IsBlank(out6.Value2) Then 'date
out6.Value2 = "Wrong dates"
out6.Value2 = fixtrail(out6.Value2)
End If
If Not IsBlank(out9.Value2) Then 'cert
out9.Value2 = "Cert Issue"
out9.Value2 = fixtrail(out9.Value2)
End If
If Not IsBlank(out10.Value2) Then 'comp
out10.Value2 = "Comp not found"
out10.Value2 = fixtrail(out10.Value2)
End If
If IsBlank(in1.Value2) Then
out1.Value2 = "Missing type"
End If
'
'many more checks happening that i omittied for brevity
'
If numComponents = 0 Then
Cells(i, 70).Value2 = "0"
Else
Cells(i, 70).Value2 = numComponents
End If
i = i + numComponents
Next i
End Function
The first idea that came to mind is using an array of Range objects to clean up the variable declarations:
Dim inRange(20) As Range
Dim outRange(20) As Range
'...
For x = i + 1 To i + numComponents
Set inRange(1) = Cells(i, 11)
Set inRange(2) = Cells(i, 12)
'...
Next
This will work especially well if you can get a formula for the cell numbers that map to each array position.
Additionally, we can improve variables around how the two loops are nested. The outer loop uses the i variable, while the inner loop uses the x variable. Since these are both looking at rows, I would re-name them as r0 and r1 (or rBase and rNested, rParent and rChild, rMaster and rDetail, etc) to help you understand what you're looking at with each index. I also see that some of the Range objects depend on the current i value, while other depend on x. You should be able to assign the i ranges above the inner loop, and save some CPU/memory work that way:
For irParent = 2 To LastRow
'...
Set inRange(1) = Cells(irParent, 11) 'test
Set inRange(2) = Cells(irParent, 12)
Set inRange(3) = Cells(irParent, 13)
Set inRange(4) = Cells(irParent, 16) 'e
'...
'If numComponents is 0, there are no child rows and this loop is skipped
For rChild = rParent + 1 To rParent + numComponents
Set inRange(10) = Cells(irChild, 50) ' date start
Set inRange(11) = Cells(irChild, 51) ' date end
'...
str = Cells(irParent, 46).Value2
msg = UBound(Split(str, ".msg"))
oft = UBound(Split(str, ".oft"))
'...
Next
irParent = irParent + numComponents
Next
Another thing is this method runs kind of long. You may want to abstract out some of the checks to a separate method, or a few separate methods that depend on what type of parent record you're looking at. Create methods that just accept the values needed for checking a particular kind of row, and then returns a single result for the check. This adds names to the code that help you understand what you're doing, as well as shorting the parent code to make it easier to read and understand at a high level more quickly.
As you make those other changes, you may want to start thinking in terms of creating Range objects that represent an entire row (or section from a row), so you can pass them to methods. This is especially true, as it appears many Range objects are currently used to hold values from single Cells. You can build strings to define non-contiguous Ranges that have the values needed for each row (including the parent cells when working in a child row). This will make building functions much easier, if you can have them simply accept a single Range object that you know has the correct cells in it.
This is also helpful because it minimizes instances where you copy from Excel Cells to memory. Moving data between VBA and Excel is a costly operation. It's usually better for performance to copy to or from a set of Cells in bulk, rather than one Cell at a time. This often holds even when it means using some extra memory. It also often helps reduce or simplify the total amount of code needed. Unfortunately, I'm too far out of VBA to show you an example.
Finally, notice my indentation. Professionals will do that consistently... even religiously. "Hacky" code does not. It's extremely helpful for spotting mistakes.
The macro below opens a series of workbooks from a list, then copies some data from them. It works fine for the first workbook, then crashes on the second. I've tried changing the order, and it's always the second workbook that causes it to crash.
Sub ImportData()
Dim lastRow As Long
Dim lastSumRow As Long
Dim j As Long
Dim k As Long
With ActiveSheet
lastRow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row
End With
For k = 2 To lastRow
k = 2
lastUsedRow = ThisWorkbook.Sheets("Summary").Cells(1048576, 1).End(xlUp).Row
If ActiveSheet.Cells(k, 2).Value <> "Imported" Then
Workbooks.Open Filename:=ThisWorkbook.Path & "\Analysis\" & Cells(k, 1), UpdateLinks:=False
ActiveWorkbook.Sheets("Summary").Activate
For j = 3 To 100
If j Mod 3 = 0 Then
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 1).Value = ActiveWorkbook.Sheets("Summary").Cells(j, 1).Value
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 2).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 1, 2).Value
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 3).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 1, 3).Value
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 4).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 1, 4).Value
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 5).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 2, 2).Value
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 6).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 2, 3).Value
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 7).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 2, 4).Value
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 8).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 1, 5).Value
End If
Next j
ActiveWorkbook.Close
End If
ThisWorkbook.Sheets("Setup").Cells(k, 2).Value = "Imported"
Next k
End Sub
I'm guessing your error is here:
Workbooks.Open Filename:=ThisWorkbook.Path & "\Analysis\" & Cells(k, 1), UpdateLinks:=False
'Ooops ^^^^^
The .Activate and .Select calls are convoluted enough that I'm not really going to expend the effort figuring out what should be the active worksheet at that particular point in your code on the second run through the loop. Whatever it is, it's different than it was when you started and an unqualified call to Cells implicitly refers to whatever worksheet is the ActiveSheet at the time. This builds a bad file name (or fails completely) and then the wheels come off.
The best thing to do is not use the Active* objects at all. Get references to the objects that you're using, and well, use them. That way there is no chance that you'll get wires crossed. While you're at it, you can give them names that make it obvious what you're working with at a glance.
Couple other things before we get to the code that doesn't use Activate and Select.
lastSumRow is never used and lastUsedRow is never declared. I'm assuming they were supposed to be the same thing. You should put Option Explicit at the top of your modules to avoid this type of error (and worse ones).
These 2 lines of code make very little sense together:
For j = 3 To 100
If j Mod 3 = 0 Then
If you only want to copy every 3rd row, skip all the division and just increment your loop counter with a Step of 3:
For j = 3 To 99 Step 3
Note that you can stop at 99, because 100 Mod 3 is never going to be 0.
Your With block here isn't using the captured reference...
With ActiveSheet
lastRow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row
End With
...but you continually use this pattern that would be useful in a With block:
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 1).Value = ...
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 2).Value = ...
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 3).Value = ...
Hard-coding Cells(1048576, 1) will fail on older versions of Excel. You should use Rows.Count instead.
As mentioned in the comments, k = 2 creates an infinite loop.
You don't need to repeatedly find the last row of the sheet you're copying to with this code:
lastUsedRow = ThisWorkbook.Sheets("Summary").Cells(1048576, 1).End(xlUp).Row
Each time you go through your "j" loop, the last row increases by one. Just add 1 to lastUsedRow instead of doing all the row counting gymnastics.
If you're working with Worksheets, use the Worksheets collection instead of the Sheets collection:
ThisWorkbook.Sheets("Summary") '<--I could return a Chart!
Put all of that together, and you come up with something like the code below. Note that I have no clue what the ActiveSheet is supposed to be when you start this macro, so I just named the variable it's stored in active. It's quite possible that it's one of the other worksheets it grabs a reference too (I have no clue) - if so, you should consolidate them into one reference:
Public Sub ImportData()
Dim lastRow As Long
Dim lastUsedRow As Long
Dim dataRow As Long
Dim fileNameRow As Long
Dim active As Worksheet
Set active = ActiveSheet
With active
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
Dim setupSheet As Worksheet
Set setupSheet = ThisWorkbook.Worksheets("Setup")
With ThisWorkbook.Worksheets("Summary")
lastUsedRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For fileNameRow = 2 To lastRow
If active.Cells(fileNameRow, 2).Value <> "Imported" Then
Dim source As Workbook
Set source = Workbooks.Open(ThisWorkbook.Path & "\Analysis\" & _
active.Cells(fileNameRow, 1), False)
Dim dataSheet As Worksheet
Set dataSheet = source.Worksheets("Summary")
For dataRow = 3 To 99 Step 3
.Cells(lastUsedRow, 1).Value = dataSheet.Cells(dataRow, 1).Value
.Cells(lastUsedRow, 2).Value = dataSheet.Cells(dataRow + 1, 2).Value
.Cells(lastUsedRow, 3).Value = dataSheet.Cells(dataRow + 1, 3).Value
.Cells(lastUsedRow, 4).Value = dataSheet.Cells(dataRow + 1, 4).Value
.Cells(lastUsedRow, 5).Value = dataSheet.Cells(dataRow + 2, 2).Value
.Cells(lastUsedRow, 6).Value = dataSheet.Cells(dataRow + 2, 3).Value
.Cells(lastUsedRow, 7).Value = dataSheet.Cells(dataRow + 2, 4).Value
.Cells(lastUsedRow, 8).Value = dataSheet.Cells(dataRow + 1, 5).Value
lastUsedRow = lastUsedRow + 1
Next
source.Close
End If
setupSheet.Cells(fileNameRow, 2).Value = "Imported"
Next
End With
End Sub
I modified a script to cut a big chunck of data into small pieces to keep subscript in the range.
I suppose to import data into spreadsheet, but it says
Run-time error '9':
Subscript out of range
Code
Private Sub btnRefresh_Click()
Dim W As Worksheet: Set W = ActiveSheet
Dim Last As Integer: Last = W.Range("b2000").End(xlUp).Row
Dim Last1 As Integer
Dim Symbols As String
Dim i, n, x, y As Integer
Last1 = Last - CInt(Last / 10) * 9
x = 5
For n = Last1 To Last Step CInt(Last / 10)
For i = x To n
Symbols = Symbols & W.Range("b" & i).Value & "+"
Next i
x = i
'Stop
Symbols = Left(Symbols, Len(Symbols) - 1)
Debug.Print Symbols
'Stop
Dim URL As String: URL = "http://finance.yahoo.com/d/quotes.csv?s=" & Symbols & "&f=snxl1c7g0h0" & Cells(2, 11) & "j0k0va2j1e7rs7dy"
Dim Http As New WinHttpRequest
Http.Open "GET", URL, False
Http.Send
Dim Resp As String: Resp = Http.ResponseText
Dim Lines As Variant: Lines = Split(Resp, vbNewLine)
Dim sLine As String
y = 5
For i = y To n
sLine = Lines(i)
Debug.Print sLine
'Stop
If InStr(sLine, ",") > 0 Then
Values = Split(sLine, ",")
W.Cells(i, 3).Value = Split(Split(sLine, Chr(34) & "," & Chr(34))(1), Chr(34))(0)
W.Cells(i, 4).Value = Split(Split(sLine, Chr(34) & "," & Chr(34))(2), Chr(34))(0)
W.Cells(i, 5).Value = Values(UBound(Values) - 14)
W.Cells(i, 6).Value = Values(UBound(Values) - 13)
W.Cells(i, 7).Value = Values(UBound(Values) - 12)
W.Cells(i, 8).Value = Values(UBound(Values) - 11)
W.Cells(i, 9).Value = Values(UBound(Values) - 10)
W.Cells(i, 10).Value = Values(UBound(Values) - 9)
W.Cells(i, 11).Value = Values(UBound(Values) - 8)
W.Cells(i, 12).Value = Values(UBound(Values) - 7)
W.Cells(i, 13).Value = Values(UBound(Values) - 6)
W.Cells(i, 14).Value = Values(UBound(Values) - 5)
W.Cells(i, 15).Value = Values(UBound(Values) - 4)
W.Cells(i, 16).Value = Values(UBound(Values) - 3)
W.Cells(i, 17).Value = Values(UBound(Values) - 2)
W.Cells(i, 18).Value = Values(UBound(Values) - 1)
W.Cells(i, 19).Value = Values(UBound(Values))
End If
Next i
Symbols = ""
Next n
W.Cells.Columns.AutoFit
End Sub
First off, make sure you have
Option Explicit
at the top of your code so you can make sure you don't mess any of your variables up.
Subscript out of range means that the program declares (DIM) an array to be of a certain length, but tries to reference an element with a subscript greater than the actual length. Often, but not always, this happens because a loop goes one index too far. Another common cause is using an index that has never been assigned a valid value.