VB to Post to New Line per Button Click - excel

I recorded a macro, linked to a button, on say sheet1. The object of what I need done:
When the button is pressed, certain cells are selected and copied to a "summary" page on another sheet.
Sheet1 has a drop down that shows certain information. So after data is selected from the drop down, the user will push the button and post that data to the summary sheet.
The macro works fine (please note I am a VBA noob), but I need assistance in adding functionality that after every button press, it copies the data on the next line - in other words, if data is in row 1 already, it must place the data in row 2, and so on.
The VB code I have is as follows:
Sub Test()
'
' Test Macro
'
'
Range("C32:N32").Select
Selection.Copy
Sheets("Summary").Select
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
_
:=False, Transpose:=False
Sheets("Comm Payable").Select
Range("C3:D3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Summary").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
_
:=False, Transpose:=False
Sheets("Comm Payable").Select
Range("N1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Summary").Select
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
_
:=False, Transpose:=False
Range("B4").Select
Sheets("Comm Payable").Select
Range("O1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Range("O1").Select
End Sub
Please could someone assist with the addition described above?
Much appreciated!

It's imperative you read the link posted by PEH as you can considerably shorten and speed up your code. I think this does what you want.
Sub Test()
Dim r As Long
r = WorksheetFunction.Max(Sheets("Summary").Range("D" & Rows.Count).End(xlUp).Row + 1, 3)
Sheets("Comm Payable").Range("C32:N32").Copy
Sheets("Summary").Range("D" & r).PasteSpecial Paste:=xlPasteValues
Sheets("Comm Payable").Range("C3:D3").Copy
Sheets("Summary").Range("B" & r).PasteSpecial Paste:=xlPasteValues
Sheets("Comm Payable").Range("N1").Copy
Sheets("Summary").Range("C" & r).PasteSpecial Paste:=xlPasteValues
Sheets("Comm Payable").Range("O1").ClearContents
End Sub
As an aside, transferring values directly is more efficient than copying and pasting and here is an example of that.
With Sheets("Comm Payable").Range("C32:N32")
Sheets("Summary").Range("D" & r).Resize(.Rows.Count, .Columns.Count).Value = Value
End With

Related

How do I create a macro that will run a formula loan by loan, and paste the output in a separate sheet

I'm setting up a pricing model and am wondering how I am able to get the macro to run the pricing loan by loan and have the output pasted in a separate tab (this would also be loan by loan, so it cannot overwrite). I used the macro recorder and this is what I have so far, but I'm a novice and not sure how to loop this until it hits a blank cell (I did the first two loans....)
Sub Macro1()
'
' Macro1 Macro
'
'
Selection.Copy
Sheets("Cashflows").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Output").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Input").Select
Range("A3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Cashflows").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Output").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
The tools you need:
To figure out the last row:
Dim LastRow As Integer
LastRow = Range("A" & Rows.Count).End(xlUp).Row
'This simulates selecting the last cell in "A" Column,
'hitting "End" and "Up Arrow", then returns that row number
'as in integer.
To cycle through each row:
Dim I As Integer
For I = 1 To 10 '(Or replace "10" with "LastRow")
'Do something like look at a range value:
Debug.Print Cells(I, 1).Value
Next I
Finally, this is going to be a lot easier if you use .value = .value instead of copying and pasting:
Dim RowNum As Integer
RowNum = 10
Range("A1").Value = Range("B1").Value 'Copies Value from B1 into A1
Cells(1, 1).Value = Range("B1").Value 'Does Exact same thing as above: Cells(row, column)
'Copy A10:C10 from sheet2 to sheet1:
Sheet1.Range("A" & RowNum & ":C" & RowNum).Value = Sheet2.Range("A" & RowNum & ":C" & RowNum)
See how far you get with that and come back if you have more specific questions.
There are lots of good resources out there if you're having trouble.

VBA Macro for Pasting Data In New Row of Table - Excel

I have recorded a macro that is attempting to copy information from cells outside of a table and paste them into a new row in a table on the same sheet. When trying to run the macro I receive "Run-time error '1004': PasteSpecial method of Range class failed." The issue seems to be with the first line stating:
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
I have a collection of paste special code in this module so I am afraid that this first line might not be the only issue. Below is the code I have so far.
Sub PlaceOrder()
'
' PlaceOrder Macro
'
'
Range("A3").Select
Selection.Copy
Range("Table1[[#Headers],[Balance]]").Select
Selection.End(xlDown).Select
Selection.ListObject.ListRows.Add AlwaysInsert:=False
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range("A1").Select
Range("B3").Select
Application.CutCopyMode = False
Selection.Copy
Range("B23").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range("A1").Select
Range("C3:E3").Select
Application.CutCopyMode = False
Selection.Copy
Range("C23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 3).Range("A1").Select
Range("F3").Select
Application.CutCopyMode = False
Selection.Copy
Range("F23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 3).Range("A1").Select
Range("E3").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("D3").Select
Selection.ClearContents
Range("C3").Select
Selection.ClearContents
Range("B3").Select
Selection.ClearContents
Selection.ConvertToLinkedDataType ServiceID:=268435456, LanguageCulture:= _
"en-US"
End Sub
Any help will is greatly appreciated!
Edit:
Worksheet
Attached is screenshot of the worksheet I am working with. I would like to be able to paste the values of A3 & C3-F3, and the formula in B3 into the table seen below. A new row needs to be inserted prior to pasting all of this information.
This should work. It's basically just a clearer version of your code.
Sub PlaceOrder()
Dim tbl As ListObject
Dim LastRow As Long
Set tbl = ActiveSheet.ListObjects("Table1")
LastRow = tbl.Range.Rows.Count 'get # of last row
With ActiveSheet
'copy and paste A3
.Range("A3").Copy
tbl.Range(LastRow, 1).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
'copy and paste B3
.Range("B3").Copy
tbl.Range(LastRow, 2).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulas
'copy and paste C3:F3
.Range("C3:F3").Copy
tbl.Range(LastRow, 3).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
'clear value in B3:F3
.Range("B3:F3").ClearContents
End With
End Sub
Your original macro did not work because the system forgot the copied value after this line:
Selection.ListObject.ListRows.Add AlwaysInsert:=False

How to save and transpose a range in Excel VBA

I have a macro where I open a textfile to copy and transpose several columns into my worksheet. As it is now this actually works. However, as I am right now opening the textfile, copying a column, going back to my original worksheet pasting and transposing the data, then switching back and forward between the two sheets until all relevant columns have been copied I figured it could probably be optimized if I understood VBA a little better.
So my question is if I can save the column data as ranges instead and then copying it all at once and pasting and transposing it all at once as well?
Or will this not have any impact on the speed of my macro?
Also, as I am actually opening many textfiles (open one, close it, open the next, close it, etc) is it possible to overwrite a range when a new textfile has been opened?
I have shown an example of my code below hope you can make sense of it:
'First Selection to be copied
ActiveSheet.Cells(RowTemp + 1, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Go back to original sheet
Windows(Left(f, Len(f))).Activate
'Paste and Transpose Data
If IsEmpty(ActiveSheet.Cells(4, 2).Value) = True Then
ActiveSheet.Cells(4, 1).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveSheet.Cells(4 + 5 + Range("A2").Value, 1).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End If
'Copy 2nd set of Data
Windows(Left(z, Len(z))).Activate
Range("B1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(Left(f, Len(f))).Activate
'Paste and Transpose 2. set of data
If IsEmpty(ActiveSheet.Cells(5, 2).Value) = True Then
ActiveSheet.Cells(5, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveSheet.Cells(5 + 5 + Range("A2").Value, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End If

VBA Code to copy & paste ranges of data from one sheet to another based on date (as criteria)

I recorded the following macro and then edited the code to include a condition, but the code is not working as it is. And when I remove the 2nd IF argument the data is copied in all columns in the distination sheet. Wereas my objective is to copy the data only if the date in the columns headers are matching. Basically I values in sheet "Daily Input Form" in a simple tab and I want to have it copied in the "Daily Cash Flow" sheet (which has multiple columns) only if the date in the header of specific column matches the date in the "Daily Input Form" sheet...(which is simply the formula "Today()".
I know there is a much simpler way to write the code but I'm a novis to the VBA, so appreciate if you can help me out.
Thanks
Sub RangeCopy1()
'
' RangeCopy1 Macro
Dim lRow As Range, Cell As Object
Set lRow = Sheets("Daily Cash Flow").Range("E13:AV13")
For Each Cell In lRow
If Cell.Value = "YES" Then
Sheets("Daily Input Form").Select
Range("D7:D12").Select
Selection.Copy
Sheets("Daily Cash Flow").Select
Range("E36:AV36").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Daily Input Form").Select
Range("D15:D25").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Daily Cash Flow").Select
Range("E43:AV43").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Daily Input Form").Select
Range("D28:D34").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Daily Cash Flow").Select
Range("E56:AV56").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Daily Input Form").Select
Range("H7:H23").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Daily Cash Flow").Select
Range("E68:AV68").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Daily Input Form").Select
Range("H26:H63").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Daily Cash Flow").Select
Range("E86:AV86").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Daily Input Form").Select
Range("H66:H86").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Daily Cash Flow").Select
Range("E125:AV125").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
If Cell.Value = "" Then
Exit Sub
End If
Next
End Sub

Looping until cell is empty

I have my macro written but now I need it to run in a loop until cell I2 is empty.
Can anyone help with this?
Sheets("Value Imported Data").Select
Range("I2:Q2").Select
Selection.Copy
Sheets("Good data").Select
Range("I1").Select
Selection.End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Value Imported Data").Select
ActiveCell.Resize(40, 9).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
I assumed it would be something like this but it does not work at all
Sub CandidatesInfo()
Dim r As Range
Dim Cell As Range
Sheets("Value Imported Data").Select
Set r = Range("I2")
For Each Cell In r
If r.Notempty Then
Range("I2:Q2").Select
Selection.Copy
Sheets("Good data").Select
Range("I1").Select
Selection.End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Value Imported Data").Select
ActiveCell.Resize(40, 9).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
End If
Next
End Sub
Basically what I want to do is if I2 is empty do nothing but if it is not empty copy I2 to Q2 into another sheet and once copied go back in the sheet where the information was copied and delete the next 40 information down and 9 to the right and start over again. As I said the top macro works perfectly, now it is just a matter of starting over and over until I2 is empty.
Any help is appreciated.
Thank you very much

Resources