I am trying to simplify a code in a Macro for numbering rows of specific columns of excel. Currently I am using
With Sheet1.Range("V6")
.Value = 1
.AutoFill .Resize(V6 + C, 1), xlFillSeries
End With
The macro has already set "C" as a variable that can change each time it is run. I want to simplify the code because I don't know how to loop this to repeat in every third column. I have tried For Loops but i am new to VBA and cannot get the program to run. Looping this would help me becasue I currently have this same code altered 85 differnt times to fill 85 different columns. For example, the next set is
With Sheet1.Range("Y6")
.Value = 1
.AutoFill .Resize(Y6 + C, 1), xlFillSeries
End With
Is there a more simple way this can be accomplished?
An alternate approach using Offset to fill every third column, starting in V6.
Sub MyNumbering()
Dim c As Long, i As Long
c = 100
For i = 0 To 84
With Sheet1.Range("V6").Offset(, i * 3)
.Value = 1
.AutoFill .Resize(c), xlFillSeries
End With
Next i
End Sub
This will iterate every 3rd column starting with column V and post 85 columns of row numbers starting in row 6 and ending at C + 6
Sub mynum()
Dim c As Long: c = 100
Dim j As Long
For j = 22 To 22 + 85 * 3 Step 3
With Sheet1.Range(Sheet1.Cells(6, j), Sheet1.Cells(c + 6, j))
.Formula = "=ROW(1:1)"
.Value = .Value
End With
Next j
End Sub
Related
I made a excel sheet where certain range of cells (J11 to J36) values are updated when value in the G1 is entered.
And, then values from J11 to J36 are manually entered (or copied) to D11 to D36.
By doing this, again values of J11 to J36 will get changed. SO, then I do iterative calculation to make both ranges same.
Is there any macro code to automate this?
I tried to do until loop but it only copies first range that is J11.
FYI, in range J11 to J36, in betwen there are title rows which are J19,J20,J28,J29 that should be skipped while copying.
My current code is below,
Sub DoUntilloop()
Dim i As Integer
i = 11
For i = 11 To 16
Do Until i > 16
Cells(i, 4).Value = Cells(i, 10)
i = i + 1
Loop
Next i
End Sub
Any help on this would be greatly appreciated.
You current loop should actually be processing rows 11 to 16, not just 11 as you state in the question. However, it is designed poorly, as there is no need to have two loops - the outer loop is effectively doing nothing as it is currently written.
Sub DoUntilloop()
Dim i As Long
For i = 11 To 36
If i <> 19 And i <> 20 And i <> 28 And i <> 29 Then
Cells(i, "D").Value = Cells(i, "J").Value
End If
Next i
End Sub
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
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
This question already has answers here:
Inserting rows above a specified rows
(2 answers)
Closed 7 years ago.
I using the below macro and it inserts the row below the cell with "Card Number"
I cannot get it to go above the row no matter what I do. Probably quite basic for some but have recently only found how useful macros are
Sub Insert()
Dim c As Range
For Each c In Range("A1:A5000")
If c.Value Like "*Card Number:*" Then
c.Offset(1, 0).EntireRow.Insert
End If
Next c
End Sub
As you probably tried you cannot just do c.EntireRow.Insert since it will insert a line above and it will keep in the For Each loop infinitely. The solution is to loop through the range in reverse, like done in this answer:
Sub InsertRev()
Dim c As Range
Set rng = ActiveSheet.Range("A1:A5000")
For dblCounter = rng.Cells.Count To 1 Step -1
Set c = rng(dblCounter)
If c.Value Like "*Card Number:*" Then
c.EntireRow.Insert
End If
Next dblCounter
End Sub
Don't use the Offset in that case, the Insert command always insert rows above the selection.
Further more, if you use for each, you don't have control on the direction in which your loop will be, so it is better to use for i = with step -1 to go from bottom to top.
Why? Because if you insert a new row from row i, the row i will become the row i+1 and you will test it on the next loop and keep adding rows!
Sub Insert_Rows()
Dim i As Long
For i = 5000 To 1 Step -1
If Cells(i, "A").Value Like "*Card Number:*" Then
Cells(i, "A").EntireRow.Insert
End If
Next i
End Sub
This is how I would solve this problem but I'm not that advanced in macros and I'm sure there is a better way.
Sub Insert()
For i = 1 To 5000
If Cells(i, "A") Like "*Card Number:*" Then ' loop trough 5000 cells in column A
Rows(i + 1).Insert 'insert bottom row first so it doesn't mess with row numbers
Rows(i - 1).Insert 'then you can insert upper row
i = i + 1 'jump over the next row as it now contains the card number for sure
End If
Next i
End Sub
I need a formula or function which is going to fulfill my below mentioned need. I have a excel data of around 11000 rows and data looks somewhat like in Column A:
Now in column B i want the result to be printed like it mentioned below: which literally means it should count the values present in column A and print it in the column B, I don't need to repeat count:
Column A Column B
PC-101 1
PC-101 1
PC-102 2
PC-102 2
PC-103 3
PC-104 4
PC-106 5
PC-107 6
PC-104 4
PC-106 5
PC-106 5
I tried with the "count" series formulas but the result was null.
Even i wrote the macro as given below( which i got from stackoverflow) but even it is printing the repeating count:
Sub CountOccurence()
' Reference: Microsoft Scripting Runtime
Application.ScreenUpdating = False
Set oDict = New Dictionary
Dim wS As Worksheet
Dim r As Integer, rLast As Integer
Set wS = Sheet1
rLast = wS.Cells(1, 1).CurrentRegion.Rows.Count
For r = 3 To rLast Step 1
If Not (oDict.Exists(wS.Cells(r, 1).Value)) Then
oDict.Add wS.Cells(r, 1).Value, 1
Else
oDict.Item(wS.Cells(r, 1).Value) = oDict.Item(wS.Cells(r, 1).Value) + 1
End If
wS.Cells(r, 2).Value = oDict.Item(wS.Cells(r, 1).Value)
Next r
Set oDict = Nothing
Application.ScreenUpdating = True
End Sub
Can anyone help me regarding this? Thanks in advance.
I tried with the "count" series formulas but the result was null.
A simple Excel formula can do this.
Put 1 in Cell B1 and then put this formula in cell B2 and pull it down.
=IF(COUNTIF($A$1:$A2,A2)>1,VLOOKUP(A2,A:B,2,0),B1+1)
Assuming that your data in column a is sorted, you can simply place 1 in B2 this formula in B3 and copy it down:
=IF(A2<>A3,B2+1,B2)
:-)