Good day everyone.
I am facing a roadblock currently with an excel file that I'm creating for an assignment.
In my file, I need cells C6:C13 from sheet 'Input' to be transpose pasted in the Database sheet rows C8:J8 or C9:J9 or C10:J10 etc. based on: the content of cell C5 in the 'Input' sheet should match the one of the rows in column B.
You can find the file here: http://tinyurl.com/oz7w97g
Thanks in advance!!!
Edit 2: My problem now is, it is pasting the data in whichever cell is selected in the 'Database' sheet. For example, if J13 is selected, it will automatically paste the data in J13:Q13 without searching for the right cell.
Edit 3: I figured it out, changed 'As String' to 'As Date' and it works. To make it more efficient, is there a way I could reduce the length of this code because bear in mind there are 72 different rows it needs to refer to so I will need to type out 'If' and 'ElseIf' 72 times.
Sub Code1()
Dim strCriteria As Date
strCriteria = Cells(5, "C").Value
Range("C6:C13").Select
Selection.Copy
Sheets("Database").Select
If strCriteria = "01-01-2015" Then
Range("C7").Select
ElseIf strCriteria = "01-01-2016" Then
Range("C8").Select
ElseIf strCriteria = "01-01-2017" Then
Range("C9").Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Input").Select
Range("D13").Select
Application.CutCopyMode = False
Range("C13").Select
End Sub
OK. I see your changes. One thing you can do is lookup the destination cell based on the criteia of cell C5. I created a VLOOKUP in cell C4 that will lookup the destination based on the date in cell C5.
The formula in cell C4 is:=VLOOKUP(C5,F5:G7,2,FALSE). The table has 1/1/2015 in cell F5 and "C7" in cell G5. The other dates and cells would follow directly below it.
You can create the lookup table on another sheet if you want.
Here is the new code that then uses the looked up value in cell C4:
Sub Code1()
Dim strCell As String
strCell = Cells(4, "C").Value
Range("C6:C13").Select
Selection.Copy
Sheets("Database").Select
Range(strCell).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Input").Select
Range("D13").Select
Application.CutCopyMode = False
Range("C13").Select
End Sub
Related
Please help me with a macro for copying and pasting text from Input sheet (worksheet1) to the Reports sheet (worksheet 2) within the same excel file.
Input Sheet Format:
Name- cell J5
Date- cell J6
Start Time- cell J7
End Time- cell J8
Downtime- cell J9
I need a macro for copying J5:J9 and paste it in A2:E2, using transpose function.
Also, the sheet is shared with multiple users so it needs to be pasted in the last available row in the Reports sheet (worksheet 2).
Presently, I am using the following macro code:
Sub Report()
Sheets("Input").Select
Range("J5:J9").Select
Selection.Copy
Sheets("Reports").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Sheets("Input").Select
ActiveWindow.SmallScroll Down:=-5
Sheets("Input").Select
Range("J5:J9").Select
Selection.ClearContents
End Sub
I am getting error at "ActiveCell.Offset(1, 0).Select" while running the macro.
Please advise any changes to the code which can help me fixing the issue.
Thanks
You can rewrite everything you're doing in a few lines:
Sub Report()
' Copy the range from J5:J9 on INPUT worksheet
ThisWorkbook.Worksheets("Input").Range("J5:J9").Copy
With ThisWorkbook.Worksheets("Reports")
' Find the LAST ROW in COLUMN A
Dim lROW As Long: lROW = .Cells(.Rows.Count, 1).End(xlUp).Row
' Paste in cell A-lROW with transpose
.Range("A" & lROW).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, Transpose:=True
End With
' Clear entry in original INPUT sheet
ThisWorkbook.Worksheets("Input").Range("J5:J9").ClearContents
End Sub
I'm not sure why you're getting an error for offsetting by one row, it works for me - but it's probably to do with your method of "selecting" the last row
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 used the following macro to convert text to proper format. I select a cell and run the macro. Suppose column A contains 3 filled rows(say A1, A2 and A3 and I want to apply the formula PROPER to columns B1, B2 and B3, B1 being my active cell. When, I run the macro it takes a long time to autofill since while selecting B1 to B3, the number of rows the macro considers is till the end of the worksheet instead of the number of rows in column A. Please suggest how can I solve this issue regarding the Autofill destination.
Sub Macro7()
'
' Macro7 Macro
'
' Keyboard Shortcut: Ctrl+Shift+V
'
ActiveCell.FormulaR1C1 = "=PROPER(RC[-1])"
ActiveCell.Select
**Selection.AutoFill Destination:=Range(Selection, Selection.End(xlDown))**
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, -1).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents
End Sub
Assuming your data starts in A1, and you want to put your formulas in column B, you can use the following (note the removal of .Select)
Sub macro7()
Dim lastRow as integer
lastRow = Activesheet.usedrange.rows.count
Range("B1").Formular1c1 = "=Proper(RC[-1])"
Range("B1").AutoFill Destination:=Range(Cells(1,2),Cells(lastRow,2))
Range(Cells(1,2),Cells(lastRow,2)).Copy
Range(Cells(1,2),Cells(lastRow,2)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(Cells(1,1),cells(lastRow,1)).ClearContents
End sub
But, as asked above, why do you want this as a macro? Unless there's going to be more added, this is probably quicker and easier to do just using =Proper(a1) in the cells, and autofilling down without VBA.
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