Nested For...Next loops to copy and paste several times - vba

I want to copy the cells "A2:A" & patientprofiles + 1 and paste them in the first unused row in column D (i.e., there should be no blank cells between what's already in column D and what I want to paste there, but I also don't want to paste over what's already there). I then want to repeat this process a user-defined number of times (this variable will be called g1_observations). I then want to copy the cells "A" & patientprofiles + 2 & ":A" & 2 * patientprofiles + 1 to the new last used row in column D (i.e., taking into account that I've just pasted patientprofiles number of cells g1_observations number of times at the bottom of column D. I want to continue repeating this process a user-defined number of times (this number of times is defined by the variable numberofgrids).
For example: imagine that the user has defined that there will be three grids. Grid 1 will have 2 observations, Grid 2 will have 3 observations, and Grid 3 will have 4 observations. Also imagine that patientprofiles has been set to 40.
If this is the case, there will already be values in cells D1:D121, so I want to begin pasting in D122. I want to paste the cells A2:A41 (40 cells because patientprofiles = 40) to cells D122:D161; I want to paste the cells A42:A81 to cells D162:D201 and again to D:202:D241; and I want to paste cells A82:A121 to cells D242:D281, again to cells D282:D321, and again to cells D322:D361. I'm pasting each "grid" one less time than the number of observations for that grid, because the first group of observations for all grids is what's contained in cells D2:D121. End example
I'm pretty sure I need to use a nested For...Next loop in order to do this, but I'm having trouble with both the inner and outer loop. I think the outer loop should go something like this:
Dim i as long
For i = 0 to numberofgrids - 1
[insert inner loop here]
Next
As far as the inner loop goes, I'm not really sure what I'm doing because it keeps pasting over itself when I am pasting from two grids. The current code I have uses repeated For...Next loops and doesn't work:
Dim myLastRow as Integer
myLastRow = Worksheets("Work").UsedRange.Rows.Count
Dim j as Long
For j = 1 To g1_observations - 1
If j = 1 Then
Range(Cells(2, 1), Cells((patientprofiles + 1), 1)).Copy _
Destination:=Worksheets("Work").Cells(j * myLastRow + 1, 4)
ElseIf j > 1 Then
Range(Cells(2, 1), Cells((patientprofiles + 1), 1)).Copy _
Destination:=Worksheets("Work").Cells((j + 1) * (myLastRow / 2) + 1, 4)
Else: Range("A1").Select
End If
Next
For j = 1 To g2_observations - 1
If j = 1 Then
Range(Cells(patientprofiles + 2, 1), Cells((2 * patientprofiles + 1), 1)).Copy _
Destination:=Worksheets("Work").Cells(j * myLastRow + 1, 4)
ElseIf b > 1 Then
Range(Cells(patientprofiles + 2, 1), Cells((2 * patientprofiles + 1), 1)).Copy _
Destination:=Worksheets("Work").Cells((b + 1) * (myLastRow / 2) + 1, 4)
Else: Range("A1").Select
End If
Next
It pastes over itself, and sometimes it skips lines. I can't really figure out how to reconcile myLastRow with a loop.
I think the inner loop should probably start off something like this:
Dim j as Long
For j = 0 to gj_observations - 1
Range(Cells(j * XXX + 2, 1), Cells((j + 1) * patientprofiles + 1).Copy _
Destination:=Worksheets("Work").Cells(myLastRow * j + 1) , 4
but I'm having difficulty because the variables are called g1_observations, g2_observations, g3_observations, etc., all the way up to g10_observations, and obviously gj_observations won't work. I want to loop on the number between "g" and "_", but I don't know how to get VBA to read variables that way, or if that's possible at all.
Can anyone help me out here? My mind is spinning from trying to understand the concept of loops, especially with different variables at each level.
Also, side question, how do you tell VBA to do nothing in an If statement? I currently have it selecting A1 by writing Else: Range("A1").Select, but I'm sure there's a better way of doing it.

When you're writing macros, it's a better practice to work with ranges and avoid manipulating cells one at a time in a loop. Your macro will run much faster and the code will be clearer.
If you want to create a set of variables that you can access by number, you would use something called an array. This is a pretty fundamental concept that exists in almost every programming language, so I'll refer you to MSDN or your favorite VBA language reference guide for more details.
Dim ws As Worksheet
Dim lr As Long ' Last Row
Dim szpp As Long ' Size (rows) patient profiles
Dim szgobsrv(2) As Long ' Size (rows) observation groups
Dim i As Long
Dim j As Long
Dim SourceCells As Range
Dim TargetCell As Range
Set ws = Sheets("Work")
szpp = 40
szgobsrv(0) = 1
szgobsrv(1) = 2
szgobsrv(2) = 3
For i = 0 To UBound(szgobsrv)
lr = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1
' copy the patient profile cells multiple times depending on group size
For j = 0 To szgobsrv(i) - 1
Set SourceCells = ws.[A2].Offset(i * szpp).Resize(szpp)
Set TargetCell = ws.[D1].Offset(lr + j * szpp)
SourceCells.Copy TargetCell
Next
Next
Note the usage of the Resize and Offset methods. These are helpful Range methods that can change the size and position of a range by a fixed amount.

The main problem you are having with values being over written is that youre not using Offset.
Another important thing to remember about nested loops is that the nested loop runs i times per loop of the upper level loop. I am thinking that nested loops here might not be good for you. You could probably just make them all independent loops?
If you want to loop to the number contained within the variable you might want to set that variable equal to a number.
example:
g2_observations =2
For j = 1 To g2_observations - 1
Aside from this I am actuall yhaving difficulty understanding what you need, but hopefully this helps?
numberofgrids = input
i = 1 to numberofgrids
gridCount = gridCount + 1
'Loop Stuff
Case Select gridCount
Case is = 1
'logic
Case is = 2
'logic
Etc etc
End Select
If numberofgrids = gridCount Then
Exit For
End If
Next i

Related

=LEFT(H2,5) To show data for all rows and stop at last row of data

Hi could someone enlighten me with some VBA code to insert formula =LEFT(H2,5) into column M and then stop at the last row of data.
The data it will be referencing will be inserted from the web so when i refresh the data pull the rows could be more or less so it can't be a fixed without using VB
Thanks
Rhys
You don't need a loop for this:
Sub qwerty()
Dim N As Long, r As Range
N = Cells(Rows.Count, "H").End(xlUp).Row
Set r = Range("M2:M" & N)
r.Formula = "=LEFT(H2,5)"
End Sub
You will find that the addresses in the formulas adjust just like in copy/paste.
Would a while loop work for you?
Dim i As Integer
i = 2 'starting row number
While Cells(i, 1).Value <> "" 'Empty row
Cells(i, 13).Formula = "=LEFT(H2,5)" 'replace this with something for that row, concatenating i to H will work i think.
i = i + 1
Wend
You'll also want to put this code to whenever the data is refreshed so it inserts the formula to all rows again.
Dim x As Long
x = Application.CountA(ActiveSheet.Columns(13))
ActiveSheet.Cells(2, 13) = "=LEFT(H2,5)"
ActiveSheet.Cells(2, 13).Resize(x - 1).Formula = ActiveSheet.Cells(2, 13).Formula
use excel function CountA to get the total number of row that you need to populate and assign that number to x
then put the actual formula on cells M2 then copy the formula until the last row using resize function

How to apply ATPVBAEN into a dataset with skipped data within the same column?

So I have a problem where I am stuck and cannot figure out a way to solve it. My code is explained ahead, but the main issue is that I must apply a smoothening exponential function with ATPVBAEN, by sections, because data is not always present, although my x axis still needs to be progressive for each measurement and some may be skipped, as displayed below:
0 34.5
2 40.6
4 41.5
6
8
10 30.4
12 32.9
Since I need to use exponential smoothening in a set of data, so programmatically I accessed in the following form the ATPVBAEN add-in provided by Excel.
Preparing my data:
Dim plan As Worksheet
Set plan = ThisWorkbook.Sheets("PLANILLA")
Dim plan2 As Worksheet
Set plan2 = ThisWorkbook.Sheets("FILTER")
Dim data As Worksheet
Set data = ThisWorkbook.Sheets("DATA")
Getting offsets and coping values to be extracted from original data before using he exponential smoothening.
k = data.Range("C2", data.Range("C2").End(xlDown)).Rows.Count 'Find last index x axis column
p = k + 15 'Set offset
plan2.Range("K16", "K" & p).Value = data.Range("E2", "E" & k + 1).Value 'Copy values
plan2.Range("L16", "L" & p).Value = data.Range("E2", "E" & k + 1).Value
plan2.Range("M16", "M" & p).Value = data.Range("F2", "F" & k + 1).Value
Now, I run the function that allows me to do the data smoothening, placing data in the row L (destination), using the data from column D (origin). So finally I do the following:
Application.Run "ATPVBAEN.XLAM!Expon", plan2.Range("L16", "L" & p), plan2.Range("D16", "D" & p), smoothVal, False, False, False
Here is where I need a way in which I can apply the function in sections, because I have data that skips some cells, leaving them empty. The problem is that Excel assumes empty data as a 0, and my measurements get affected in a really bad way. Is there a work around to apply the ATPVBAEN by parts like in a for loop (setting on each loop the beginning and end with the variables p and k like above)? How can I be able to recognize where the beginning and end of each subset of data is located within the column?
Because the line :
(…, data.Range("C2").End(xlDown)).Rows.Count
seems to be not an effective solution.
My code works greatly when I use the full length of the column with a continuous dataset, but I would like to make it possible to work with datasets that have skipped data.
Many thanks!!
So the solution and a way to work around is the following:
Use a Loop to iterate over data until we know there are not any subsets left. Skip the subsets doing a module operation to get the reminder og the interation count.
Do While reachMax > k 'Control how many times I can iterate over data
init = prev = k
counter = counter + 1
k = data.Range("E" & 1, data.Range("E" & init).End(xlDown)).Rows.Count 'Find last index of column
p = k + 15 'Set offset because we are working with data of other sheet
If (counter Mod 2) = 1 Then 'Able to skip subsets with no data
Application.Run "ATPVBAEN.XLAM!Expon", plan2.Range("K" & prev + 14, "K" & p), plan2.Range("C" & prev + 14, "C" & p), smoothVal, False, False, False
End If
Loop
Obviously we are setting the variables of reachMax with the x axis last data, and k with the index number of the y-axis data, in this located in columns C (destination) and K (origin)

Excel VBA: Find first value in row larger than 0 and sum over following 4 cells

As a complete beginner to VBA Excel, I would like to be able to do the following:
I want to find the first value larger than 0 in a row, and then sum over the following 4 cells in the same row. So
Animal1 0 0 1 2 3 0 1
Animal2 3 3 0 1 4 2 0
Animal3 0 0 0 0 0 1 0
Results in
Animal1 7
Animal2 11
Animal3 1
Is this possible?
(Your problem description didn't match your examples. I interpreted the problem as one of summing the 4 elements in a row which begin with the first number which is greater than 0. If my interpretation is wrong -- the following code would need to be tweaked.)
You could do it with a user-defined function (i.e. a UDF -- a VBA function designed to be used as a spreadsheet function):
Function SumAfter(R As Range, n As Long) As Variant
'Sums the (at most) n elements beginning with the first occurence of
'a strictly positive number in the range R,
'which is assumed to be 1-dimensional.
'If all numbers are zero or negative -- returns a #VALUE! error
Dim i As Long, j As Long, m As Long
Dim total As Variant
m = R.Cells.Count
For i = 1 To m
If R.Cells(i).Value > 0 Then
For j = i To Application.Min(m, i + n - 1)
total = total + R.Cells(j)
Next j
SumAfter = total
Exit Function
End If
Next i
'error condition if you reach here
SumAfter = CVErr(xlErrValue)
End Function
If your sample data is in A1:H3 then putting the formula =SumAfter(B1:H1,4) in I1 and copying down will work as intended. Note that the code is slightly more general than your problem description. If you are going to use VBA, you might as well make your subs/functions as flexible as possible. Also note that if you are writing a UDF, it is a good idea to think of what type of error you want to return if the input violates expectations. See this for an excellent discussion (from Chip Pearson's site - which is an excellent resource for Excel VBA programmers).
ON EDIT: If you want the first cell greater than 0 added to the next 4 (for a total of 5 cells in the sum) then the function I gave works as is, but using =SumAfter(B1:H1,5) instead of =SumAfter(B1:H1,4).
This is the one of the variants of how you can achieve required result:
Sub test()
Dim cl As Range, cl2 As Range, k, Dic As Object, i%: i = 1
Set Dic = CreateObject("Scripting.Dictionary")
For Each cl In ActiveSheet.UsedRange.Columns(1).Cells
For Each cl2 In Range(Cells(cl.Row, 2), Cells(cl.Row, 8))
If cl2.Value2 > 0 Then
Dic.Add i, cl.Value2 & "|" & Application.Sum(Range(cl2, cl2.Offset(, 4)))
i = i + 1
Exit For
End If
Next cl2, cl
Workbooks.Add: i = 1
For Each k In Dic
Cells(i, "A").Value2 = Split(Dic(k), "|")(0)
Cells(i, "b").Value2 = CDec(Split(Dic(k), "|")(1))
i = i + 1
Next k
End Sub
Here is what I would use, I dont know any of the cell placement you have used so you will need to change that yourself.
Future reference this isnt a code writing site for you, if you are new to VBA i suggest doing simple stuff first, make a message box appear, use code to move to different cells, try a few if statments and/or loops. When your comftable with that start using varibles(Booleans, string , intergers and such) and you will see how far you can go. As i like to say , "if you can do it in excel, code can do it better"
If the code doesnt work or doesnt suit your needs then change it so it does, it worked for me when i used it but im not you nor do i have your spread sheet
paste it into your vba and use F8 to go through it step by step see how it works and if you want to use it.
Sub test()
[A1].Select ' assuming it starts in column A1
'loops till it reachs the end of the cells or till it hits a blank cell
Do Until ActiveCell.Value = ""
ActiveCell.Offset(0, 1).Select
'adds up the value of the cells going right and removes the previous cell to clean up
Do Until ActiveCell.Value = ""
x = x + ActiveCell.Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(0, -1).ClearContents
Loop
'goes back to the begining and ends tallyed up value
Selection.End(xlToLeft).Select
ActiveCell.Offset(0, 1).Value = x
'moves down one to next row
ActiveCell.Offset(1, 0).Select
Loop
End Sub

VBA Excel word search and copying formulas

I'm searching for a VBA macro for Excel, which can detect the word "mean", in column A. After this it would copy the yellow row with the formula in C to J.
The formula counts the average from one row after the last "mean" to the next =AVERAGE (C1323:C1437)
after every sixth mean there also needs to be Area and 150 copyied two rows after mean and I and J Need to be changed. Consequently I and J would refer to the cell A1441 in this case (=G1439/C1439*$A$1441) till the end of the file.
I'm not quite sure if it's easy or not but I'm totally overchallenged. I would be very thankful for help.
Sub Makro1()
'
' Makro1 Makro
'
' Tastenkombination: Strg+q
strSearchWord = "Mean"
i = Application.WorksheetFunction.CountIf(Range("A:A"), strSearchWord)
Y = 2
For x = i To 0
i = Application.WorksheetFunction.Match(strSuchWort, Range("A:A"), 0)
Range("C" & i).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" ' that's still wrong, should be something like i-y?
Selection.AutoFill Destination:=Range("C" & i:"J" & i), Type:=xlFillDefault
Range("CY:JY").Select
i = Y
'for each fifth i
'Range("A" & i + 3).Select
' ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-6]*R2159C1"
Next x
End Sub
it's still wrong, but my first draft.
#stucharo the Area correction is difficult to describe I've added a better Picture with formulas. I hpe that now it's understandable
If your line ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" needs to change the number of rows betwen means each time then you'll need to add a variable as you comment suggests. Also, just writing the string to the cells value (ActiveCell.Value) means that you will see it written as a formaula when you click the cell in the workbook (and it'll highlight the range etc.). You could try replacing it with:
ActiveCell.Value = "=AVERAGE(R[" & i - Y & "]C:R[-1]C)"
although since I can't see the first row of your sheet I'm not certain that'll give you the correct range of rows each time.
If your row number is likely to change and you are copying over the same number of columns each time then it might also be just as easy to write the formula directly to cells within a loop, rather than explicitly copying it.
Adding text after every 6th "mean" would require you to keep count of how many means had passed so far. This can be done by incrememnting a counter variable and using the Mod operator will tell you the remainder after a division. Therefor numberOfMeans Mod 6 will give you the remainder when divided by 6 and when this equals zero you know you have a multiple of 6. I've tried to capture all this into the code below.....
Sub Test()
Application.ScreenUpdating = False
Dim startRow As Integer
startRow = 2
Dim endrow As Integer
endrow = Range("A2").End(xlDown).row
Dim lastMeanRow As Integer
lastMeanRow = startRow - 1
Dim areaRow as Integer
areaRow = lastMeanRow + 3
Dim meanCounter As Integer
meanCounter = 0
Dim avgColHeight As Integer
Dim col As Integer
Dim row As Integer
'Check each row in the sheet
For row = startRow To endrow
'Cols i and j in every row need to be modified
For col = 9 To 10
Cells(row, col).Value = "=RC[-2]/RC[-6]*R" & areaRow & "C1"
Next col
'If column 1 of that row contains "mean" then
If Cells(row, 1).Value = "mean" Then
'Calculate the column height to average over....
avgColHeight = row - lastMeanRow - 1
'...and loop through each of the columns....
'(including i and j to add average)
For col = 3 To 10
'....inserting the averaging formula.
Cells(row, col).Value = "=AVERAGE(R[-" & avgColHeight & "]C:R[-1]C)"
Next col
'Then increment the counter to keep track of the number of means
meanCounter = meanCounter + 1
'If the number of means is a multiple of 6 then
If (meanCounter Mod 6 = 0) Then
'insert the "Area" and "150" strings
Cells(row + 2, 1).Value = "Area"
Cells(row + 3, 1).Value = "150"
areaRow = row + 3
End If
'Finally change the lastMeanRow to the mean row we have just processed.
lastMeanRow = row
End If
'Do it again until we reach the end of the data
Next row
Application.ScreenUpdating = True
End Sub
I also noticed your point on the value of area changing periodically. Writing this programatically, as above, will aloow you to add some logic over the value of "Area" and when it changes.
You clearly have a long list of data and want to automate the creation of the rows and formulas you describe.
It is possible write VBA to scan through the data and modify the formulas etc but first I would question if this is the best approach to give you what you need.
Excel has a feature called "pivot tables" which essentially allows you to summerise data in a list.
for instance if the list had one row for each city in the world and gave the population in the city, and a column gave which country it was in. A pivot table could be used to create the average population for a country of the countries cities. I suspect you are doing this sort of thing.
If you don't know about pivot tables you should find out about them. See here
In your case your mean row is summeriseing data in the rows above it. To use pivot tables you would have to have a column that defined which group each row is in. You pivot table would sue this column as a row summary and you would then create the average for all the other column.
#Nathalie. It's hard to help without knowing more. eg Is the data delivered with the mean text already inserted. It looks like column A has a number the represent the row number within the group (and this could be used by a formula to create the "Group Name" column you need for pivot tables.
You can get the pivot tables to do the area adjustment by:
Creating a new set of columns which contains formulas that cause the values in columns C to J to be copied except for when it is the 6th set of data in which case you adjust the values in C to J accordingly).
You probably need to introduce columns that:
A. give the "group name"
B. give a count of which group it is in so every 6th you can do the adjustment you need.
4 by using pivot tables and basic techniques you will find it easie rot update the refresh the data, should you need to.

For Each Next loop unexpectedly skipping some entries [duplicate]

This question already has answers here:
Excel VBA deleting rows in a for loop misses rows
(4 answers)
Closed 4 years ago.
I have been coding a macro in Excel that scans through a list of records, finds any cells with "CHOFF" in the contents, copying the row that contains it, and pasting those cells into another sheet. It is part of a longer code that formats a report.
It has worked just fine, except that the "For Each" loop has been skipping over some of the entries seemingly at random. It isn't every other row, and I have tried sorting it differently, but the same cells are skipped regardless, so it doesn't seem to be about order of cells. I tried using InStr instead of cell.value, but the same cells were still skipped over.
Do you have any idea what could be causing the code just not to recognize some cells scattered within the range?
The code in question is below:
Dim Rng As Range
Dim Cell As Range
Dim x As Integer
Dim y As Integer
ActiveWorkbook.Sheets(1).Select
Set Rng = Range(Range("C1"), Range("C" & Rows.Count).End(xlUp))
x = 2
For Each Cell In Rng
If Cell.Value = "CHOFF" Then
Cell.EntireRow.Select
Selection.Cut
ActiveWorkbook.Sheets(2).Select
Rows(x).Select
ActiveWorkbook.ActiveSheet.Paste
ActiveWorkbook.Sheets(1).Select
Selection.Delete Shift:=xlUp
y = x
x = y + 1
End If
Next Cell
The For Each...Next loop doesn't automatically keep track of which rows you have deleted. When you delete a row, Cell still points to the same address (which is now the row below the original one, since that was deleted). Then on the next time round the loop, Cell moves onto the next cell, skipping one.
To fix this, you could move Cell up one within the If statement (e.g. with Set Cell = Cell.Offset(-1,0)). But I think this is one of the rare cases where a simple For loop is better than For Each:
Dim lngLastRow As Long
Dim lngSourceRow As Long
Dim lngDestRow As Long
Dim objSourceWS As Worksheet
Dim objDestWS As Worksheet
Set objSourceWS = ActiveWorkbook.Sheets(1)
Set objDestWS = ActiveWorkbook.Sheets(2)
lngLastRow = objSourceWS.Range("C" & objSourceWS.Rows.Count).End(xlUp).Row
lngDestRow = 1
For lngSourceRow = lngLastRow To 1 Step -1
If objSourceWS.Cells(lngSourceRow, 3).Value = "CHOFF" Then
objSourceWS.Rows(lngSourceRow).Copy Destination:=objDestWS.Cells(lngDestRow, 1)
objSourceWS.Rows(lngSourceRow).Delete
lngDestRow = lngDestRow + 1
End If
Next lngSourceRow
This loops backwards (as per Portland Runner's suggestion) to avoid having to do anything about deleted rows. It also tidies up a couple of other things in your code:
You don't need to do any Selecting, and it's better not to (see this question for why)
You can specify a destination within Range.Copy rather than having to do a separate select and paste
You can change the value of a variable "in place" without having to assign it to a second variable first (i.e. x = x + 1 is fine)
you should use Long rather than Integer for variables that contain row numbers, since there are more rows in an Excel spreadsheet than an Integer can handle (at least 65536 compared to 32767 max for an Integer)
Obviously test that it still does what you require!
Try using Selection.Copy instead of Selection.Cut
If you have to remove those lines you can mark the lines (for example writing something in an unused cell) inside the loop and then remove it once finished the main loop.
Regards
I had a similar issue when I was trying to delete certain rows. The way I overcame it was by iterating through the loop several times using the following:
For c = 1 To 100
Dim d As Long: d = 1
With Sheets("Sheet")
For e = 22 To nLastRow Step 1
If .Range("G" & e) = "" Or .Range("I" & e) = "" Then
.Range("G" & e).EntireRow.Delete
.Range("I" & e).EntireRow.Delete
d = d + 1
End If
Next
End With
c = c + 1
Next
So, basically if you incorporate the outer for loop from my code into your code, it should work.