I have been working on some code which contains several Do Until Loops but when I run it the first loop works as expected but the second and other loops are completely bypassed.
I have run the individual loops in independent sub routines and they worked as needed.
I have also checked previous threads and can't seem to find an example of the same problem.
I initially tried re-declaring i = 2 for the second loop thinking i still valued > than lastRow from the first loop.
On top of this I have also tried changing the variable from i to j for the second loop but this also made no difference.
Here an example of the code I am using:
Dim i As Long
i = 2
Do Until i > lastRow
Cells(i, 16).Select
If ActiveCell.Offset(rowOffset:=0, columnOffset:=-13) <> "Invoice" Then
ActiveCell = ""
ElseIf ActiveCell.Offset(rowOffset:=0, columnOffset:=-12) <> "" Then
ActiveCell = ""
ElseIf ActiveCell.Offset(rowOffset:=0, columnOffset:=-9) <> "Usage Actual" Then
ActiveCell = ""
ElseIf ActiveCell.Offset(rowOffset:=0, columnOffset:=-3) = "Final" Then
ActiveCell = ""
Else: ActiveCell. _
FormulaR1C1 = ' vlookup formula to data source
End If
i = i + 1
Loop
' Additional code to paste out formula and save work book
Dim j As Long
j = 2
Do Until j > lastRow
' from here the process skips right past the next loop to the Additional code to paste out formula and save work book noted below
Cells(j, 17).Select
If ActiveCell.Offset(rowOffset:=0, columnOffset:=-1) = "Yes" Then
ActiveCell.FormulaR1C1 = ' vlookup formula to data source
Else: ActiveCell = ""
End If
j = j + 1
Loop
' Additional code to paste out formula and save work book
I have been working on this for several days and have run out of ideas.
I have finally managed to get the code to work.
The method I ended up using involved 2 changes.
Firstly I gave each loop it's own Do Until variable - where the code posted above started with i as the first variable, the next became j, then k and so on.
This on it's own did not initially resolve the issue until I added additional processes between each loop.
For example, following the first loop I added code to perform a lookup in another column and to copy that lookup down to lastRow but without using a loop to do it. I followed this with the next loop and followed that with further additional code, also not requiring a loop to complete.
Fortunately I had enough additional processes to break up all of the loops in the project. Although I still believe running multiple loops one after another shouldn't be a problem, I have yet to find a more effective solution.
Related
My task is to use Excel to manipulate a large set of data and I had heard of using a Macro but I'm not very code-savvy. I recorded the steps that are required using the macro function, but I need to add more lines of code to utilize looping and making sure it advances by 2 after every repeat.
I've posted my steps below:
Range("A5:C5").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A5").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+0.1"
Range("B7:C7").Select
Selection.Copy
Range("B5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Basically, select 3 cells (A5:C5) insert cells and shift cells down. Use a formula in the newly empty A5 to add 0.1 to A4 and copy values from B7:C7 and paste into B5:C5.
The following image shows a before and after of what I'm talking about to make things more clear.
Before
After
The next step would be:
Range("A7:C7").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A7").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+0.1"
Range("B9:C9").Select
Selection.Copy
Range("B7").Select
ActiveSheet.Paste
Application.CutCopyMode = False
and so on.
Any help with this would be greatly appreciated. I also apologize if what I'm asking is still confusing or not clear in any way.
[Prologue:]
Hi, I'll provide you with an answer and I tried to comment the heck out of it to make it as beginner friendly as possible, but the truth of the matter is:
I can explain to you how it's done, but you will never properly understand why it's done until you properly understand basic programming methodologies such as looping and that is something only you and you alone have to sit down to and fully comprehend
[The gaps in logic:]
Probably the biggest issue is, you have not specified what happens
when your data reaches empty cells (what I mean under that) - if in
your loop you were on row 10 (7, M, N) you would have no longer any
letters to add, as the next 2 rows (12) no longer contain eny data.
Given this, I modified the loop to start at the n-2th row instead to prevent this from happening (that means in your example it will end (or start to be more precise) at 6.1 as it's the last row that can retrieve the data)
In general, I'd recommend posting not only a picture of input data, but rather than picture of current result in this case a properly explained expected result would be much more to our benefit and understanding and would have saved me a lot of the guesswork here.
[The theoretical part of your question:]
I'll save you a bit of googling time here with few useful facts.
If you're looking to repeat a specific action, you should always be looking to utilize one of the 2 (or 3 depending on how you classify them) loops for and do (while/until)
Better yet, if you're looking to loop a variant amount of actions for repeated amount of times, you should utlize either a procedure Sub or a function Function so you can use arguments that act as a variable for the loop.
Generally when adding or removing rows it's important to loop from Bottom to Top (from Last to First). Why? Because if you add an extra row, it's going to mess up your Row order.
With all that in mind, the procedure itself could look something like this:
[The solution itself:]
You can use the following procedure every time for a specified range.
Option Explicit 'prevents typo. errors, undeclared variables and so on
Private Sub extra_row(ByVal rng As Range) 'declaration of procedure
Dim i As Long
' we loop for the n-th - 2 row (last row - 2) to the pre-first (added) row.
For i = (rng.Rows.Count + rng.Row - 2) To rng.Row + 1 Step -1
'why the -2? ^ Because if you add the letters from next 2 rows,_
the last 2 would have no to grab _
eg. Row 10 and 11 in your original data would have no data under them to grab
' a bit harder section to comprehend, if it's the first data entry _
we need to account for the fact that we have not added any extra rows yet_
hence we also need to decrement the row from which we receive the data by 1 _
it 's bit of difficult to word, i'd highly recommend debugging yourself _
and seeing what happens with or without it
Dim fp As Integer
If (i - 2 = rng.Rows.Count) Then
fp = 1
Else
fp = 0
End If
' now we just add the extra rows where we can
Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i, 1) = Cells(i, 1).Offset(-1, 0) + 0.1 'we add 0.1 to cell one above
Cells(i, 2) = Cells(i + 3 - fp, 2) ' similar case, with letters, but two below
Cells(i, 3) = Cells(i + 3 - fp, 3) ' similar case, with letters, but two below
Next i 'and we loop for every cell in our specified range
End Sub
Eg. in your case, you could run the procedure with the following command:
Call extra_row(Range("A4:A11"))
[Practical use]
While the solution itself should work, in a real world example it probably might be smarter not to use a specific range to call for each procedure. Especially if that means use has to look at the worksheet, check the range and count the rows manually.
That's one of the reasons we created a procedure here to begin with. So I created one more procedure akin to main() in most programming languages which detects the last active row and applies the procedure to your data range by detecting it automatically.
So in the end, your could should look something like this:
Option Explicit
Private Sub extra_row(ByVal rng as Range)
'... code from the answer here
End Sub
Private Sub rundata()
Dim lr As Long
lr = Sheets("Your Sheet Name").Cells(Rows.Count, 1).End(xlUp).Row
'detects the last active (nonempty) row _
rememeber to change the Sheets("") to wherever your data is stored
Dim mydata As Range
Set mydata = Range("A4:A" & lr) 'under presumption your data always begins with A4
Call extra_row(mydata)
End Sub
Now, whenever you would run (manally) or Call the run_data() procedure it would automatically detect the range and apply the procedure we defined to it.
[Expected result visualization and closing words:]
We started with this:
After running the procedure:
Now I know, it may seem like there's a lot of novel concepts here, but truth of the matter is, all of them are fairly easy once you buckle down and try to comprehend the code line by line. Most of it is simple mathematical operations.
If you still have trouble comprehending anything here, do your own research first and then post comment here or better yet, create a new question (if it warrants it).
Good luck on your coding journey! :)
Rawrplus
This code should do the trick.
The code gives you an InputBox in which you can type in the number of times to run the code.
Sub test()
Application.ScreenUpdating = False
Dim Grab As Range
Dim RunTimes As Long
On Error GoTo Get_Out
RunTimes = InputBox("How many times shall the code run?", "Run times")
On Error GoTo 0
For x = 1 To RunTimes * 1.5 + 3 Step 2
Set Grab = ActiveSheet.Range("A" & x + 4)
Grab.EntireRow.Insert
Grab.Offset(-1, 0).Value = Grab.Offset(-2, 0).Value + 0.1
Grab.Offset(-1, 1).Value = Grab.Offset(1, 1).Value
Grab.Offset(-1, 2).Value = Grab.Offset(1, 2).Value
Next x
MsgBox "Succes"
Get_Out:
Application.ScreenUpdating = True
End Sub
Let me know if you have any questions about the code or if you want me to explain it further :)
I am pulling my hair out over this as I cannot see why this isn't working. Any help or guidance would be greatly appreciated.
I have inherited a macro in Excel which runs differently depending on which PC we run it on. Essentially, the macro inserts blank rows into a table of data (which should also have conditional formatting to make it blue to break up the table and make it easier to read). On my PC instead of a blank row being entered, it is a row of #ref errors and loses the formatting.
We have a different macro assigned to a button which runs three macros one after another. The one I have the issue with is the third of these three. When I run the macros as three separate events it works, but together it has the #ref errors.
Sorry for the small snippet of the file, but it is sensitive information.
I have tried adding a pause in between the second and third, but this doesn't help.
Are there some security settings which I should check?
The macro looks at a formula in column A and looks for the number 5 and inserts a row after this line. The code is as follows:-
Sub Main()
Dim r As Range
Dim i As Long
i = 1
Do While Range("A" & i).Value <> ""
If Left(Range("a" & i), 2) = "5" Then
i = i + 1
Rows(i).Insert
Range("A" & i).Value = Range("a" & i - 1).Value
End If
i = i + 1
Loop
End Sub
What I am struggling to get my head around is that it works in isolation, but not when run with other macros. For completeness the macro which runs the three has the following code:-
Sub runall_CVR()
Application.ScreenUpdating = False
Call hiderows_CVR
Call Delete0s_cvr
Call Main
Application.ScreenUpdating = True
End Sub
Many thanks
James
I have data that comes from different sources via Get Data/Connections that goes into a sheet/table called RawData. I have created a macro linked to a button the user must click to fill in some of the data in RawData with an index/match function that points to another workbook where the reservation number from RawData is matched to the other workbook to determine the length of stay.
I am not appending said workbook to the RawData table for different reasons. I can go that route if need be but I figured there would be an easier route before we cross that bridge. The issue I have is that once the macro is ran, the other workbook, at times, may not have the reservation data. In these cases, I had to manually determine this data.
This new data can be placed within my main workbook [but I currently have it in it's own workbook (LOSNAintoActualLOS.xlsm) as I've been running tests on making this work]. And the formula has to be pasted into the table because when the table refreshes, the row of data that would normally have the length of stay removes the formula and replaces it with it's original value, a blank cell.
What I need is for my code to loop through all the cells within the F column of a table, determine the cells with #N/A errors, then paste a formula in the error cell. I have done some research and can't seem to find something that suits my needs. I attempted doing this as a loop but seeing as I'm still pretty new to VBA coding, it's definitely not my strong suit.
Sub Macro2()
Dim r As Integer
LastRow = Range("B" & Rows.Count).End(xlUp).Row
With Worksheets("Sheet1").Range("F2:F" & LastRow)
For r = 2 To LastRow
If .IsError(Worksheets("Sheet1").Range("F" & r)).Value Then
.Formula = "INDEX(LOSNAintoActualLOS.xlsm!Table1[#Data],MATCH([#Reservation],LOSNAintoActualLOS.xlsm!Table1[Reservation],0),7)"
.Value = .Value
End If
Next r
End With
End Sub
When I run the code for my If statement I get Run-time error '438': Object doesn't support this property or method. If I remove the first period from .IsError I get Compile error: Invalid qualifier.
IsError is not part of Worksheets("Sheet1").Range("F2:F" & LastRow)
Switch it up like this.
Sub Macro2()
Dim r As Long
Dim LastRow As Long
LastRow = Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row
For r = 2 To LastRow
With Worksheets("Sheet1").Range("F" & r)
If IsError(.Value) Then
.Formula = "INDEX(LOSNAintoActualLOS.xlsm!Table1[#Data],MATCH([#Reservation],LOSNAintoActualLOS.xlsm!Table1[Reservation],0),7)"
.Value = .Value
End If
End With
Next r
End Sub
I'm trying to create a macro in VBA in Excel to copy the contents of one worksheet to another (eventually will be upgraded to copying contents from one workbook to another but need to prove the concept first) but I keep encountering Run-time error '9': "Subscript out of range". The thing is, I can't see what part of the highlighted line could possibly ever be out of range.
I am using a workbook called "MetaTesting" that has 3 worksheets, and the following bit of code starts at A1 and only ever increments upwards. I have previously been able to refer to these two worksheets to be able to copy across a single row, so I know the problem isn't there. It is the fourth line of text that is being highlighted by the debugger (the line starting "Do While Trim(Application...").
Note: edited to take into account file name extension (as suggested in comments). Same error still being thrown, but now it's being thrown on line 11 (under the first comment)
Private Sub CommandButton21_Click()
Dim i As Integer, j As Integer, k As Integer
i = 1
Do While Trim(Application.Workbooks("MetaTesting.xlsm").Worksheets(3).Cells(i, 1).Value) <> ""
j = 1
Do While Trim(Application.Workbooks("MetaTesting.xlsm").Worksheets(3).Cells(1, j).Value) <> ""
'Copy cell data from one sheet to the other
Application.Workbooks("MetaTesting.xlsm").Worksheets(1).Cells(i, j).Value = Application.Workbooks("MetaTesting.xlms").Worksheets(3).Cells(i, j).Value
j = j + 1
Loop
'Copy formatting of previous row and paste it on current row. Starts at row 3, copying formatting from row 2
If i > 2 Then
k = i - 1
Application.Workbooks("MetaTesting.xlsm").Worksheets(1).Cells(k, j).Copy
Application.Workbooks("MetaTesting.xlsm").Worksheets(1).Range(Cells(i, 1), Cells(i, j)).PasteSpecial Paste:=xlPasteFormats
End If
i = i + 1
Loop
End Sub
Any and all help appreciated.
You can do this without all the loops, just copy the whole worksheet - the Copy function will handle skipping empty areas for you.
Workbooks("MetaTesting").Worksheets(1).Cells.Copy
Workbooks("MetaTesting").Worksheets(2).Cells.PasteSpecial xlPasteValues
To copy only a block of cells:
Workbooks("MetaTesting").Worksheets(1).Range("A1:M100").Copy
Workbooks("MetaTesting").Worksheets(2).Range("F12").PasteSpecial xlPasteValues ' this is the top-left corner of the paste, it'll fill in the rest
The issue on line 11 is probably due to the ("MetaTesting.xlms"). Looks like a little mistake on the file extentions; should be .xlsm like it is in the first half of the equation.
OK, now that it is determined that the workbook extension was required, let's cut your code down to what is necessary.
with Workbooks("MetaTesting.xlsm")
.Worksheets(3).Cells.Copy Destination:=.Worksheets(1).Cells
.Worksheets(1).Cells = .Worksheets(1).Cells.Value
end with
I am trying to copy only the values from a table to a different sheet, however the below code is only copying the formulas thus losing references. I have tried different solutions such as adding .Value to .DataBodyRange.Copy Cells(i,1) however didn't work.
Thanks for your help
Sub loadData()
Application.AutoCorrect.AutoFillFormulasInLists = False
Dim wsh As Worksheet, i&
Application.ScreenUpdating = 0
With ActiveSheet.ListObjects(1)
If ActiveSheet.FilterMode Then .Range.AutoFilter
.DataBodyRange.Delete
i = 4
For Each wsh In ThisWorkbook.Worksheets
If wsh.Name <> "Template" Then
With wsh.ListObjects(4)
.DataBodyRange.Copy Cells(i, 1)
i = i + .ListRows.Count
End With
End If
Next wsh
.Range.AutoFilter Field:=5
End With
Application.ScreenUpdating = 1
End Sub `
This question might help you. Try changing the format (values or formulas) when pasting the values using pastespecial.
You are already using loops to accomplish your checks. You should use loops to finish the job and don't worry about using the clipboard to copy and paste. I can understand using copy and paste especially if you don't understand loops, but you clearly do.
You can do another loop where you set the values for the cells one at a time.
LastCol = Sheets("Sheet1").Cells(1, Columns.count).End(xlToLeft).Column 'Get last column of row with data
For col = 1 To LastCol
Sheets("Sheet2").Cells(i, col).Value = Sheets("Sheet1").Cells(i, col).Value
Next col
This isn't a complete solution, but if you insert this into your code where you are trying to copy and paste, you should get a good idea of how to complete this. Again, I'd avoid using copy and paste macros, simply because it's quicker to just write a three or four line loop in VBA than to record a macro, then edit it, clean it up, modify it, and debug it. It sure seems like less work to "record a macro" but in my experience, the code is quicker and more accurate. You know exactly what is happening instead of some parameters you might not want to question and don't know what they do.