Do While ActiveCell <> Range - vba

I have this VBA excel macro code
Sub fillcells()
Range("J14").Select
Do While ActiveCell <> Range("J902")
ActiveCell.Copy
ActiveCell.Offset(6, 0).Select
ActiveCell.PasteSpecial
Loop
End Sub
At first it was working fine but now sometimes when I try to run the macro the loop suddenly stops at cell J242, other times is arising an error 'mismatch type' and sometimes the macro just select cell J14 without doing the loop

Not sure what you want to do, but (as noted in the comments to your OP), don't use .Select/.Activate. The following should do what (I think) you wanted:
Sub fillcells()
Dim i& ' Create a LONG variable to count cells
For i = 14 To 901 Step 6
Cells(i, 10).Offset(6, 0).FormulaR1C1 = Cells(i, 10).FormulaR1C1
Loop
End Sub
This will loop from cell J14 to J901, copy/paste* to a cell 6 rows offset.
* Note I didn't actually copy/paste. Since your original code used PasteSpecial, I'm assuming you just want the values pasted. In this case, you can set the two ranges/cells equal.

Just an addition to what #BruceWayne already said: whenever you have this typical phenomenon that something happens only "sometimes" it is often a case of using keywords such as Active or Current or Selection. These are not specific but change each time that you call the macro. Whatever you have selected is the starting point. You might even start clicking around and thus change Selection while the macro is running. In short, you should start coding explicitly and don't allow VBA / Excel to assume / make the decision for you.
Let's start with Range("J14").Select. This line of code asks VBA to make already two assumptions:
If you have several Excel files open. Which Excel file should it start with?
Within the file there might be several sheets. On which of these sheets should J14 be selected?
Explicit coding means that you (hopefully at all times) be very specific what you are referring to. So, instead of just stating Range("J14") you should use:
ThisWorkbook.Worksheets("SheetNameYouWantToReferTo").Range("J14")
But is pointed out in the other answer, this is not even necessary in this case. Rather loop the rows as shown and use:
ThisWorkbook.Worksheets("SheetNameYouWantToReferTo").Cells(i, 10).Offset(6, 0).Formula = ThisWorkbook.Worksheets("SheetNameYouWantToReferTo").Cells(i, 10).Offset(i, 10).Formula
Since this is a bit lengthy you can shorting it by using a With statement:
With ThisWorkbook.Worksheets("SheetNameYouWantToReferTo")
.Cells(i, 10).Offset(6, 0).Formula = .Cells(i, 10).Formula
End With

Related

Copying columns including blanks without skipping rows..leave "blanks" blank VBA

Aplication Defined error Copying a specified column and range including blanks with an embedded button running multiple Macros. I know that all rows will be filled in column A so if I could reference the rest of the Macros to A.end
I've looked Google youtube and here although there is a lot of info on copying and pasting, I cannot find one that works for this running multiple Macros.
Macros 5 & 6 is where I start having problems because these columns have multiple blanks throughout.
Raw data to Copy:
Destination:
Private Sub CommandButton1_Click()
Worksheets("Sheet1").Range("a2", Range("a2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("a2") 'macro1
Worksheets("Sheet1").Range("d2", Range("d2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("b2") 'Macro2
Worksheets("Sheet1").Range("c2", Range("c2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("c2") 'macro3
Worksheets("Sheet1").Range("g2", Range("g2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("d2") 'macro4
If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = "<0" Then
Worksheets("Sheet2").Range("i2").Copy 'macro5
If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = ">0" Then
Worksheets("Sheet2").Range("j2").Copy 'macro6
Worksheets("Sheet2").Activate 'macro7
Range.end(xldown) only gets you a contiguous range (effectively it will stop at the first blank cell).
Since you want to include blanks, you might want to instead work from the last row of your worksheet back up to the first non-blank cell encountered in that column (which is a way of getting the last row).
This would mean something like:
' If you are new to With statements (below), any objects within the With block that begin with a . relate to "Sheet1". Saves us typing Sheet1 repeatedly, and makes sense to use it since we access a lot of Sheet1's members like range/cells/rows
With Worksheets("Sheet1")
.Range("a2", .cells(.rows.count, "A").End(xlup)).Copy Worksheets("Sheet2").Range("a2") 'macro1
End with
Untested, written on mobile -- but hope it works or gets you closer to a solution. You would need to copy-paste the above and change the A to B, C, D, E, etc. I wasn't too sure what you're trying to achieve with the "<0" condition in macro 5 and 6.
(It would better if you turned the code into a parameterised Sub and just provide the column letter/number as an argument to the sub, but just depends how new you are to VBA and programming in general -- and for the time being whatever is easier for you to understand/maintain.)
Edit regarding macro 5 and 6
With Worksheets("Sheet1")
Dim cell as range
For each cell in .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
If cell.Value <= 0 Then 'Get rid of the equal sign if you don't want it in your logic/condition'
Cell.Copy Worksheets("Sheet2").cells(cell.row, "I") 'Macro5
ElseIf cell.value > 0 Then
Cell.Copy Worksheets("Sheet2").cells(cell.row, "J") 'Macro6
End If
Next cell
End With
Worksheets("Sheet2").Activate 'macro7

Range SpecialCells ClearContents clears whole sheet instead

I have a sheet in Excel 2010 which is setup as a pseudo form (I didn't create it, I'm just trying to fix it) so formatting suggests that the user can only enter in certain cells. Depending on certain functionality these areas need to be reset, i.e. cleared although formulae and standard/conditional formatting need to be kept. I have defined each of these cells/ranges as named ranges so I can easily loop through them using the following code: -
Public Sub ResetDetailSheet()
Dim nm As Name
With ThisWorkbook
For Each nm In .Names
If Left(nm.Name, 9) = "nmrDetail" Then
Range(nm.Name).SpecialCells(xlCellTypeConstants).ClearContents
End If
Next
End With
End Sub
For some reason instead of clearing the constants from the specific range it is clearing constants from the entire sheet so I am losing all titles/headings. Formulae and standard/conditional formatting are staying as expected.
What am I doing wrong?!?!
As a test using the immediate window I tried clearing a specific cell, e.g.
Range("G7").SpecialCells(xlCellTypeConstants).ClearContents
But this still cleared all constants from the entire sheet.
What am I missing? I don't understand. Maybe I'm being dumb.
Sorry, I can't upload an example. This place is pretty locked down.
Range({any single cell}).SpecialCells({whatever}) seems to work off the entire sheet.
Range({more than one cell}).SpecialCells({whatever}) seems to work off the specified cells.
So, make sure your range has more than a single cell before you clear it - if the range is only a single cell, then check if it .HasFormula; if that's the case then its .Value isn't a constant:
With ThisWorkbook
For Each nm In .Names
If Left(nm.Name, 9) = "nmrDetail" Then
If nm.RefersToRange.Count > 1 Then
nm.RefersToRange.SpecialCells(xlCellTypeConstants).ClearContents
ElseIf Not nm.RefersToRange.HasFormula Then
nm.RefersToRange.ClearContents
End If
End If
Next
End With
Note that I'm using Name.RefersToRange instead of fetching the range by name off the active sheet.

Looping the whole cells to change a specific formula issue

I'm writing a function to change an entire column to new values using a formula, here's the code I'll elaborate more on the idea down there.
The problem is that it hangs and I have to rerun Excel and I'm not sure why.
Sub Button2_Click()
Dim i As Long
For i = 2 To Rows.Count
Cells(i, 4).Formula = "=B" & i & "+6*3600000/86400000+25569"
Next i
End Sub
So what's this about? I'm changing the fourth column to excel time because what I have in column B is epoch time, and this is the formula I'm using, it works with my case if I tried one by one, but for some reason it won't work as a whole. I'm not sure what's done wrong? But I'd appreciate your help.
Writing to cells one-by-one is very slow.
Writing formulas one-by-one is slower still, because each must be evaluated before Excel accepts them as formulas.
Doing this a million times can literally freeze Excel.
The solution is to write them all in one shot (no loops):
Sub Button2_Click()
[d2:d1048576] = "=B2+6*3600000/86400000+25569"
End Sub
' Another way of doing mass calculation is by using copy and paste method.
It will be better to convert the columns into values so that the sheet won't calculate again and again. It helps to prevent the sheet from hanging issues
Sub Button2_Click()
Range("D2").Formula = "=b1" & "+6*3600000/86400000+25569"
Range("D2").Copy
Range("D2:d1048576").PasteSpecial xlValues
Application.CutCopyMode = False
Range("D:D").Value = Range("D:D").Value
End Sub

Freeze on close after ListObject Resize

I have an Excel file that takes data from outside and writes it in a ListObject.
As adding rows one by one through ListRows.Add is very slow, I add the right number of empty rows to the sheet and resize the ListObject.
This works really well in Excel 2010.
With Excel 2007, it works but when the user closes the workbook or Excel, it freezes and Windows displays its crash window (asking if you want to close, restart or debug the application).
This is really annoying and doesn't look very good :).
Any idea of what I could do to prevent that?
Maybe you have a better idea to quicky ladd thousands of rows in a ListObject?
Moreover randomly (I reopen the file change nothing and execute the macro), Resize fails with an error message and Excel crashes if I stop the execution.
Here is the function that adds the empty rows, if I follow it step by step it all the ranges are correct and it does what I need.
I'm pretty sure this is this function that causes the problem as it disappears when I comment the call to that function.
Sub AddRowsToListObject(sheetName As String, myTable As ListObject, addRows As Long)
Dim i As Long
If addRows > 0 Then
Sheets(sheetName).Activate
'Add empty rows at the end
i = myTable.DataBodyRange.row + myTable.ListRows.Count
Sheets(sheetName).Range(Cells(i, 1), Cells(i + addRows - 2, 1)).EntireRow.Insert shift:=xlDown
'Offset -1 as you need to include the headers again
myTable.Resize myTable.DataBodyRange.Offset(-1, 0).Resize(myTable.ListRows.Count + addRows, myTable.ListColumns.Count)
End If
End Sub
Unfortunately I don't have Excel 2007 and cannot replicate the error described in the question. However and assuming that:
The code is not trying to add rows beyond the capacity of Excel 2007
The error is caused by the method used to add new lines to the existing ListObject
And since you are asking for an alternative method to add thousands of rows to an existing ListObject
Try the code below
Sub ListObjects_AddRows(myTable As ListObject, addRows As Long)
If addRows > 0 Then
With myTable.DataBodyRange
.Offset(.Rows.Count, 0).Resize(addRows, 1).EntireRow.Insert
With .Offset(.Rows.Count, 0).Resize(addRows, 1)
.Value = "X"
.ClearContents
End With: End With: End If
End Sub
add Application.ScreenUpdating = False right after the start of the sub
add Application.ScreenUpdating = True right before the end
If you are doing 1000s then you definitely don't need the screen refreshing each time a new line gets drawn. Change that and it will only redraw it once it is finished.
After a lot of painful testing, it looks like the problem is not in this method but in the deleting of the rows just before that :
Sub ResetListObject(myTable As ListObject)
myTable.DataBodyRange.ClearContents
If myTable.DataBodyRange.Rows.Count > 1 Then
myTable.DataBodyRange.Offset(1, 0).Resize(myTable.DataBodyRange.Rows.Count - 1, myTable.DataBodyRange.Columns.Count).EntireRow.Delete shift:=xlUp
End If
End Sub
Excel 2010 requires you to always keep 1 row when you empty the ListObject.
But Excel 2007 requires 2 rows !!
I don't know why and I can't find any information on that.
I changed my script to delete all rows except 2 and changed the function in the OP to manage that fact.

Get the cell reference of the value found by Excel INDEX function

The Problem
Assume that the active cell contains a formula based on the INDEX function:
=INDEX(myrange, x,y)
I would like to build a macro that locates the value found value by INDEX and moves the focus there, that is a macro changing the active cell to:
Range("myrange").Cells(x,y)
Doing the job without macros (slow but it works)
Apart from trivially moving the selection to myrange and manually counting x rows y and columns, one can:
Copy and paste the formula in another cell as follows:
=CELL("address", INDEX(myrange, x,y))
(that shows the address of the cell matched by INDEX).
Copy the result of the formula above.
Hit F5, Ctrl-V, Enter (paste the copied address in the GoTo dialog).
You are now located on the very cell found by the INDEX function.
Now the challenge is to automate these steps (or similar ones) with a macro.
Tentative macros (not working)
Tentative 1
WorksheetFunction.CELL("address", ActiveCell.Formula)
It doesn't work since CELL for some reason is not part of the members of WorksheetFunction.
Tentative 2
This method involves parsing the INDEX-formula.
Sub GoToIndex()
Dim form As String, rng As String, row As String, col As String
form = ActiveCell.Formula
form = Split(form, "(")(1)
rng = Split(form, ",")(0)
row = Split(form, ",")(1)
col = Split(Split(form, ",")(2), ")")(0)
Range(rng).Cells(row, CInt(col)).Select
End Sub
This method actually works, but only for a simple case, where the main INDEX-formula has no nested subformulas.
Note
Obviously in a real case myrange, x and ycan be both simple values, such as =INDEX(A1:D10, 1,1), or values returned from complex expressions. Typically x, y are the results of a MATCH function.
EDIT
It was discovered that some solutions do not work when myrange is located on a sheet different from that hosting =INDEX(myrange ...).
They are common practice in financial reporting, where some sheets have the main statements whose entries are recalled from others via an INDEX+MATCH formula.
Unfortunately it is just when the found value is located on a "far" report out of sight that you need more the jump-to-the-cell function.
The task could be done in one line much simpler than any other method:
Sub GoToIndex()
Application.Evaluate(ActiveCell.Formula).Select
End Sub
Application.Evaluate(ActiveCell.Formula) returns a range object from which the CELL function gets properties when called from sheets.
EDIT
For navigating from another sheet you should first activate the target sheet:
Option Explicit
Sub GoToIndex()
Dim r As Range
Set r = Application.Evaluate(ActiveCell.Formula)
r.Worksheet.Activate
r.Select
End Sub
Add error handling for a general case:
Option Explicit
Sub GoToIndex()
Dim r As Range
On Error Resume Next ' errors off
Set r = Application.Evaluate(ActiveCell.Formula) ' will work only if the result is a range
On Error GoTo 0 ' errors on
If Not (r Is Nothing) Then
r.Worksheet.Activate
r.Select
End If
End Sub
There are several approaches to select the cell that a formula refers to...
Assume the active cell contains: =INDEX(myrange,x,y).
From the Worksheet, you could try any of these:
Copy the formula from the formula bar and paste into the name box (to the left of the formula bar)
Define the formula as a name, say A. Then type A into the Goto box or (name box)
Insert hyperlink > Existing File or Web page > Address: #INDEX(myrange,x,y)
Adapt the formula to make it a hyperlink: =HYPERLINK("#INDEX(myrange,x,y)")
Or from the VBA editor, either of these should do the trick:
Application.Goto Activecell.FormulaR1C1
Range(Activecell.Formula).Select
Additional Note:
If the cell contains a formula that refers to relative references such as =INDEX(A:A,ROW(),1) the last of these would need some tweaking. (Also see: Excel Evaluate formula error). To allow for this you could try:
Range(Evaluate("cell(""address""," & Mid(ActiveCell.Formula, 2) & ")")).Select
This problem doesn't seem to occur with R1C1 references used in Application.Goto or:
ThisWorkbook.FollowHyperlink "#" & mid(ActiveCell.FormulaR1C1,2)
You could use the MATCH() worksheet function or the VBA FIND() method.
EDIT#1
As you correctly pointed out, INDEX will return a value that may appear many times within the range, but INDEX will always return a value from some fixed spot, say
=INDEX(A1:K100,3,7)
will always give the value in cell G3 so the address is "builtin" to the formula
If, however, we have something like:
=INDEX(A1:K100,Z100,Z101)
Then we would require a macro to parse the formula and evaluate the arguments.
Both #lori_m and #V.B. gave brilliant solutions in their own way almost in parallel.
Very difficult for me to choose the closing answer, but V.B. even created Dropbox test file, so...
Here I just steal the best from parts from them.
'Move to cell found by Index()
Sub GoToIndex()
On Error GoTo ErrorHandler
Application.Goto ActiveCell.FormulaR1C1 ' will work only if the result is a range
Exit Sub
ErrorHandler:
MsgBox ("Active cell does not evaluate to a range")
End Sub
I associated this "jump" macro with CTRL-j and it works like a charm.
If you use balance sheet like worksheets (where INDEX-formulas, selecting entries from other sheets, are very common), I really suggest you to try it.