cut copy paste macro across 2 sheets with dynamic range - excel

I have a sheet with a range of A12:N112, Column A is my trigger column (1 or ) based on changing criteria). The first bit of my macro which works sorts this range to all the rows with a 1 are at the top of the range. It then opens the destination sheet as well.
The next bit of code below, needs to copy cells B:L for each row with a 1 in column A and paste that into the first empty row in the destination sheet starting at column D. This then generates a number which the then copied and pasted back into the first sheet in column M of that specific row. This then needs to loop until all of the rows with a 1 in column A have been processed.
Can anyone help, here is my code, which runs but nothing is copied or pasted.
Dim lr As Long lr = Sheets("Data Entry").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step 1
If Range("AB" & r).Value = "1" Then
Rows(r).Copy.Range ("A" & lr2 + 1)
Windows("Serialisation Log.xlsx").Activate
Sheets("SNo Log").Select
Range("D" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("Serialisation Log.xlsx").Activate
Sheets("SNo Log").Select
Range("A" & Rows.Count).End(xlUp).Offset(-1).Select
Selection.Copy
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
Range("A" & Rows.Count).End(xlUp).Offset(0).Select
Selection.Copy
Windows("Serialisation Generator rev 1.xlsm").Activate
Worksheets("Data Entry").Select
Range("N").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If Range("AB" & r).Value = "0" Then
Range("I4").Select
ActiveCell.FormulaR1C1 = "Serial No. Issue complete for this OA"
End If
Range("F5").Select
Next r
Any help will be greatly appreciated.

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.

How do I exclude cells where the formula returns zero?

My file has four sheets.
From all of them, I want to copy and paste column A (from A:10) (which contains a concat formula) when some other rows are populated and then save into a csv.
All rows from A10 onwards have the concat formula which is then filled in depending on the other columns (the same applies for the other sheets).
I have it currently creating sheet1, and pasting there, then saving as a csv.
However, from the first sheet it looks at, it takes only the first line (but the second line - J11 (and so A11) are populated.
In the other sheets, it is copy and pasting the 2 rows that are populated, but also all the other rows as there are formulas there that return zero.
As I have the .End(xlDown) and technically all the other rows are populated.
I tried an IF statement for the last sheet only as a test, and currently it only copies the first populated line, and not the second (but at least it also doesn't copy all the other cells with zero).
Essentially, for each sheet I'd like to loop through with for example E10 is populated, copy and paste A10 into Sheet1, etc., if E10 is not zero.
Sub Output_test1()
'
' Output_test1 Macro
'
'
Sheets("Create").Select
Range("A10", Range("J10").End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets.Add.Name = "Sheet1"
Sheets("Sheet1").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Assign").Select
Range("A10", Range("E10").End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A1").End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Date & Time").Select
Range("A10", Range("E10").End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A1").End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Event Type").Select
Dim rg As Range
For Each rg In Range("E10").End(xlDown)
If rg.Value > 0 Then
End If
Range("A10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A1").End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Application.CutCopyMode = False
Next
Sheets("Sheet1").Move
myTime = Format(Now, ("dd.mm.yy"))
ChDir "C:\Users\"
ActiveWorkbook.SaveAs Filename:= _
"Recruit_" & myTime & ".csv", FileFormat:=xlCSVUTF8, _
CreateBackup:=False
End Sub
There is no loop in your code not are you checking any values. I assumed you need to check column J in the source sheet and copy column A to the destination sheet.
This is a possible starting point:
k = 1
For i = 10 to 20
If Sheets("Source").Range("J" & i).Value = 0 then
Sheets("Destination").Range("A" & k).Value = Sheets("Source").Range("A" & i).Value
k = k + 1
End if
Next i
This only copies the value, not the formula. Not sure how much to explain, comment on the answer if any questions

Selection.AutoFill Destination not working as desired

I have following code
First it will insert two columns one by one
Then count rows in C column
Then Copy ActiveCell.FormulaR1C1 = "=R[-5]C[18]" to B7 to rows count
Similarly, Copy ActiveCell.FormulaR1C1 = "=R[-5]C[13]" to A7 to rows count
But I am getting error when the Active Row is only 01 (One), if it is more than one then it works ok.
I am struggling with this. If anyone can please help.
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Dim LastRow As Long
LastRow = Range("C" & Rows.Count).End(xlUp).Row
Range("B7").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-5]C[18]"
Range("B7").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("B7:B" & LastRow), Type:=xlFillCopy
Range("B7:B" & LastRow).Select
Range("A7").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[-5]C[13]"
Range("A7").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("A7:A" & LastRow), Type:=xlFillCopy
Range("A7:A" & LastRow).Select
To close the question out:
Instead of using AutoFill, maybe do Range("B7:B" & LastRow).Value = Range("B7").Value, and similarly for column A.
Or just in one line for both columns: Range("A7:B" & LastRow).Value = Range("A7:B7").Value.
First off, the Selection object is not necessarily the best option. You can insert the columns with Range("A:B").Insert xlShiftToRight.
Next, you can set the formula for an entire range at once rather than copying and pasting. Since you're putting the formulas only starting at row 7, you'll need to offset and resize the range that is defined by what is in Column C (after the insert).
The Resize method will need to reduce the row count by 6 since the formulas don't start until row 7:.Resize(LastRow - 6). Since the original range is only one column wide, the column count in the Resize method can be omitted (otherwise, it'd be .Resize(LastRow - 6, 1)).
The Offset method will need to shift down 6 rows and left 1 (or 2) columns: .Offset(6,-1) and .Offset(6,-2)).
Your code would then be greatly simplified to:
Dim LastRow As Long
ActiveSheet.Range("A:B").Insert xlShiftToRight
LastRow = Range("C" & Rows.Count).End(xlUp).Row
With Range("C:C").Resize(LastRow-6)
.Offset(6,-1).FormulaR1C1="=R[-5]C[18]"
.Offset(6,-2).FormulaR1C1="=R[-5]C[13]"
End With
Of course, even easier would be to convert your sheet to a Table ("ListObject" in VBA) and let Excel do the heavy lifting. But that's way outside what you asked.

Find value in table then copy values in different columns to a different table

I have a table in Sheet1 of a workbook and several rows of the table will have #N/A as their value of column N. I would like to find a way to have a vba macro find all rows that have #N/A in column N then copy the values from column M and L of those rows to the bottom of another table on Sheet2 of the same workbook.
ActiveSheet.ListObjects("SEC_Data").Range.AutoFilter Field:=14, Criteria1:= _
"#N/A"
Range("M88343:M88351").Select
Selection.Copy
Sheets("LKUP_Client Name").Select
Range("B2").Select
Selection.End(xlDown).Select
Range("B" & ActiveCell.Row + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("company_2018 thru2019_gim").Select
Range("L88343:L88351").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("LKUP_Client Name").Select
Range("C").Select
Selection.End(xlDown).Select
Range("C" & ActiveCell.Row + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
The way I would approach this is to first iterate through column N on sheet 1, when #N/A found then copy the cells and paste in corresponding location on sheet 2. Something like the below:
Sub CopyProcedure()
Dim i As Long
Dim lRow1 As Long, lRow2 As Long
Dim wsSheet1 As Worksheet, wsSheet2 As Worksheet
Set wsSheet1 = Sheets("Sheet 1")
Set wsSheet2 = Sheets("Sheet 2")
lRow1 = wsSheet1.Range("N" & wsSheet1.Rows.Count).End(xlUp).Row
'assuming your data starts in the first row
'iterate to the last row of column n
For i = 1 To lRow1
'look for the #N/A text
If wsSheet1.Range("N" & i).Text = "#N/A" Then
'adjust this to suit which column in sheet 2 you need
lRow2 = wsSheet2.Range("A" & wsSheet2.Rows.Count).End(xlUp).Row + 1
'when text found copy required cells
wsSheet1.Range("L" & i, "M" & i).Copy
'paste cell values in required location on sheet 2
'NOTE THIS WILL PASTE IN THE LAST ROW SPECIFIED ON SHEET 2 AND IN COLUMN A
'adjust as you see fit
wsSheet2.Range("A" & lRow2).PasteSpecial xlPasteValues
'empty clipboard
Application.CutCopyMode = False
End If
Next i
Set wsSheet1 = Nothing
Set wsSheet2 = Nothing
End Sub
This is by no means the most efficient way to do it, but I am sure it will get the job done if I understand your problem correctly.
Also, caveat, I haven't tested or debugged this. :)

insert formula in column until next non blank cell

In my macro, i need to insert a formula in columns AA and AB, AB is empty so no problem there. Column AA has data which starts in AA10954, my problem is AA10954 changes each week as my data either increases or decrease as i import from another book, can someone help me to set the last empty cell before my data starts in AA?
Sub ClassVisit()
'
' ClassVisit Macro
'
'
Dim lr As Long
With ActiveWorkbook
With ActiveSheet
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
Range("AA2").Formula = "=IFERROR(VLOOKUP(A2,[Data.xlsb]Stores!$A:$AA,27,0),VLOOKUP(A2,'[Salesinfo.xlsb]Packs'!$C:$E,3,0))"
Range("AB2:AB" & lr).Formula = "=IFERROR(VLOOKUP(A2,Attribute!D:F,3,0),""Not Visited"")"
Range("AA2").Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A10953")
ActiveCell.Range("A1:A10953").Select
Range("AA2:AB" & lr).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.End(xlUp).Select
Application.CutCopyMode = False
ActiveCell.Offset(1, -26).Range("A1").Select
End With
End With
End Sub

Resources