I've managed to create an easy to update dashboard in Excel using VBA. It's pretty solid, but I require a weekly updated trendline to add to this data.
What i'd like is a macro that does the following:
Write data to range X (e.g. A1:A5)
Copy data from range X to Range Y (e.g. A10:A15)
And then when I run step 1 and 2 again
Write data to range X (overwrite data in X A1:A5)
Copy Data from range Y to range Y+1 (e.g. B10:B15)
repeat ad infinitum (each time moving one column to the right)
What I get is that i need to define the column line as an integer and then refer to it.
(e.g.
Sub Trend()
Dim i As Integer
i = 2
Sheets("Data").Select
Range("A1:A5").Select
Selection.Copy
Sheets("Trendline data").Select
ActiveSheet.Cells(1, i).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Data").Select
i = i + 1
End Sub
However repeating this macro does not increment i for me.
~~Also column 2 is filled completely with a repeat of the data in (Data!A1:A5)~~
This is fixed with an update to the code.
Pretty much what I need to fix is that The line
"Dim i As integer"
i = 2
becomes
"Dim i As integer"
i = 3
Permanently, and repeat the next time for i = 4, i = 5 etc.
After that for me it is easy to create a line chart from this range
Thank you.
edit: wrote what I thought would work, but apparently doesn't
Edited :
What about that?
Sub Trend()
Dim i as integer
If Sheets("Data").Cells(1,1).Value = "" Then
Sheets("Data").Cells(1,1).Value = 1
End if
i = Sheets("Data").Cells(1,1).Value
Sheets("Data").Select
Range("A1:A5").Select
Selection.Copy
Sheets("Trendline data").Select
ActiveSheet.Cells(1, i).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Data").Select
Sheets("Data").Cells(1,1).Value = i + 1
End Sub
Related
I am new to VBA. Actually, my objective is to copy every 4 columns with 5 rows one after one to a new worksheet named USD.
Below is my code but it is not working in a loop.
Sub CopyColumns()
Range("A5:D9").Select '**I want to add 4 columns till the end of last column with data**
Selection.Copy
Sheets("Test").Select
Sheets.Add.Name = "USD"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test").Select
**'Sceond loop should be like below**
Range("E5:H9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("USD").Select
Range("A6").Select '**I need to paste data after last row used every time**
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
you need a loop and a way to move your selection. For loop look up While because you dont know exactly how many times you want to repeat the code and for variables you can use Offset or directly put them into Cells to specify the selection.
Sub CopyColumns()
Dim iCycle As Long
iCycle = 0
Sheets.Add.Name = "USD"
Sheets("Test").Select
While Range("A5").Offset(0, iCycle * 4).Value <> "" 'checks if there are any values left to be copied
Range("A5:D9").Offset(0, iCycle * 4).Copy 'Offset moves whole selection by 4 columns to the right every time
Sheets("USD").Select
Sheets("USD").Range(Cells(1 + iCycle * 5, 1), Cells(1 + iCycle * 5, 4)).PasteSpecial Paste:=xlPasteValues 'Cells can also be used to specify selection based on variable
Sheets("Test").Select
iCycle = iCycle + 1
Wend
End Sub
I have data that looks like the table shown below. The number of observations in this dataset varies each month. The columns remain the same. I would like to loop my code through each row until the row is empty. I think a do while loop would be appropriate, but I have not been successful in executing it thus far (of note, I am a complete VBA newbie.)
A couple of other notes: The only thing that will change as the code runs through each observation of data is the Range selected in line 2 (I will want to move down to the next row of observations) and the final range selected for the Paste Special step in the final line of the code (again, I will want to move down to the next row of observations with each iteration).
Sample Data:
Sex Age Race Total Cholesterol HDL-Cholesterol Systolic Blood Pressure Treatment for High Blood Pressure Diabetes Smoker
F 50 AA 300 90 200 Y Y Y
M 55 AA 290 90 200 Y Y Y
F 50 AA 300 90 200 N N N
Code that I need to loop through each non-empty row:
Sub ASCVD()
Sheets("Sheet1").Select
Range("A2:I2").Select
Selection.Copy
Sheets("Omnibus").Select
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("B13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("J2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Thank you very much in advance for your help!!!
On second thought, what you are really asking is how to use a Do While loop:
Sub ASCVD()
Dim row As Integer
row = 2
Do While ThisWorkbook.Sheets("Sheet1").Cells(row, 1) <> "" 'Loop until first cell is empty
ThisWorkbook.Sheets("Sheet1").Range("A" & row & ":I" & row).Select
Selection.Copy
Sheets("Omnibus").Select
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("B13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("J" & row).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
row = row + 1
Loop
End Sub
The code loops throw rows 2, 3, 4, 5 .... and stops when it finds a row where the first cell is empty
Create an example of your desired end result, it is extremely unclear what you want to achieve at the moment. (Right now you are only describing a mess of implementation, not what the big picture is)
Anyway I am assuming all you want to do is transpose your data, this code does the job:
Sub ASCVD()
Dim Data() As Variant
Dim nrow As Integer
Data() = ThisWorkbook.Sheets("Sheet1").Range("A1").CurrentRegion.Value
nrow = UBound(Data(), 1)
ThisWorkbook.Sheets("Omnibus").Activate
DoEvents
'Previous two lines needed so that the .Range(Cells(3.3), ... part works below
ThisWorkbook.Sheets("Omnibus").Range(Cells(3, 3), Cells(16 + 2, nrow + 2)) = Application.WorksheetFunction.Transpose(Data())
'Cells(rownumber, columnnumber). Cells(1,1) is cell A1
'Cells(3, 3) is same as cell C3.
'Cells(16 + 2, nrow + 2) in your example case will be cell F18, the last cell of your data.
'+2 because you want to start from C3, meaning all your data is shifted two cells down and two cells right
End Sub
I am very new to vba (and code in general) so I apologise if I haven't asked the right question or have missed a thread that covers this. I have spent a couple of weeks trying to find the answer so hopefully you may be able to help.
I am trying to copy, data from one sheet (Named Master Sheet) to another depending on a variable in column L (Variables "In Progress" or "Not Started") to an Overview / GUI sheet. My current code (below) does this for the first line of data, however I would like this to work for the whole sheet.Unfortunately it will have a changing amount of data added so the array will be expanding- unsure how much more difficult this will make it.
Thank you very much for any help you can provide, and I apologise for the marked out notes. I can add a picture too (if possible) if it would help make more sense of what I would like to do?
Sub Update_Uncompleted_Tasks()
' Update_Uncompleted_Tasks Macro
' Selects tasks from Master Sheet and copies to the Overview Sheets if assigned as uncompleted
'DON'T USE BELOW YET (UNSURE IF IT WILL WORK)
'Maybe Vlookup?
'Dim LastRow As Long, i As Long
'LastRow = Cells(Rows.Count, "L").End(xlUp).Row
'For i = 1 To LastRow
Sheets("Master Sheet").Select
If Range("L2") = "In Progress" Then
Range("A2:L2").Select
Selection.Copy
Sheets("Overview").Select
Application.Goto Reference:="R10000C2"
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ElseIf Range("L2") = "Not Started" Then
Range("A2:L2").Select
Selection.Copy
Sheets("Overview").Select
Application.Goto Reference:="R10000C2"
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
'Next i
End Sub
First of all you should take a look at this: Avoid using select in Excel-VBA-Macros.
The following code should fulfill your needs, but it requires that your data in column L has no empty cells (until the end is reached)
Sub Update_Uncompleted_Tasks()
Dim row as Long
'Initial value
row = 2
With ThisWorkbook.Worksheets("Master Sheet")
Do Until IsEmpty(.Range("L" & row))
If (.Range("L" & row).Value = "In Progress") Or (.Range("L" & row).Value = "Not Started") Then
.Range("A" & row & ":L" & row).Copy
ThisWorkbook.Worksheets("Overview").Range("B10000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
row = row + 1
Loop
End With
End Sub
The loop ends when a row is reached where the cell in column L is empty.
EDIT: You can also replace the Do Until -- Loop with a For row=2 To lastRow -- Next row. To determine the last row of your data, there are many ways, check out this link Excel-VBA find last row or just use the search function.
You can use this piece of code to get the number of last nonempty line on your sheet:
Dim LastDataLine As Long
LastDataLine = Sheets("Master Sheet").Range("A" & Rows.Count).End(xlUp).Row
And for last non-empty column (just in case):
Dim LastDataCol As Integer
LastDataCol = Sheets("Master Sheet").Cells(1, Columns.Count).End(xlToLeft).Column
If you also need help implementing a loop which goes through each line leave a comment.
The assignment requires me to run the Monte Carlo result 1000 times. I already create a row of 30 years values(B5:AE5), and I want to repeat the process 1000 times. Every time, there will be a new row comes out, and all the values will be random.
Below is my code, for some reason, it will go to the very bottom of my excel sheet. I want the second row of 30 years values inside (B6:AE6).
Sub Macros()
Dim trail As Long
trail = InputBox("Enter the number of time you want to simulate this Macros", "Macros", "10")
For i = 1 To trail
Application.CutCopyMode = False
Range("B5").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Selection.End(xlDown).Select
Selection.Offset(-1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A4").Select
Selection.End(xlDown).Select
Selection.Copy
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMod = False
Next i
Range("B4").Select
End Sub
Thank you sooo much!
To answer your question about why your End(xlDown) takes you to the end of the sheet, the Selection.End(xlDown).Select is similar to pressing Ctrl+Down on the spreadsheet. (Likewise Selection.End(xlToRight)).Select is similar to pressing Ctrl+Right.)
Hence if you are on an empty sheet, or if all the cells beneath the active (or referenced) cell are empty, then pressing Ctrl+Down will bring you to the last row.
All that said, you can avoid that whole issue and improve your code significantly by
Removing all the Select statements and work directly with the range objects.
Using the defined range (B5:AE5) since you know what it is.
Just using the counter to resize the range to to paste the values and formats (and eliminate the loop).
See the code below:
Sub Macros()
Dim trail As Long
trail = InputBox("Enter the number of time you want to simulate this Macros", "Macros", "10")
With Range(Range("B5"), Range("AE5"))
.Copy
.Offset(1).Resize(trail - 1, 30).PasteSpecial xlPasteValues
.Offset(1).Resize(trai1 - 1, 30).PasteSpecial xlPasteFormats
End With
With Range("A5")
.Copy .Offset(1).Resize(trail - 1)
End With
'if you don't need to copy the formats you can change the above With statements to just this:
'With Range("A5:BE5")
' .Offset(i).Resize(trail - 1,31).Value = .Value
'End With
End Sub
It sounds like you want to place formulas in the selected number of rows.
Sub Frmla()
Dim i As Long
i = InputBox("enter Number")
Range("B6:AE" & 5 + i).FormulaR1C1 = "=R[-1]C*0.7"'whatever the formula is
End Sub
I have the below vba code created to copy and paste data. The report I'm creating captures historical data to be updated every hour. I need to be able to paste into the next available cell below B10 but cannot figure out how to do that, any suggestions? Thanks!
Range("A7").Select
Selection.Copy
Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
The code assumes that you want the value in cell "A7" to be sent to the first available(blank) cell below B10:
Sub Next_Available()
Dim nextAvailableCell As Long
nextAvailableCell = Application.WorksheetFunction.Max(Cells(Rows.Count, "B").End(xlUp).row + 1, 11)
Range("B" & nextAvailableCell) = Range("A7")
End Sub