How to copy entire row from one sheet with specific value to another sheet (in different workbook)using macros - vba

As a beginner in field of macros, I need advise on how to copy/paste an entire row if column R has value = "YES", from sheet "database", to the next available blank row in sheet2.
Also Sheet2 is another file/workbook at location "C:\Users\Desktop\KPIs"

Example assumes the workbook you want to paste to is already open.
If R1 is "YES" then it copies row 3 to row 3 in the Target workbook
Sub CopyRow()
Dim copyRng As Range
If Worksheets("Database").Range("R1") = "YES" Then
Worksheets("Database").Range("A3").EntireRow.Copy Destination:=Workbooks("Target").Worksheets("Sheet1").Range("A3")
End If
End Sub

Related

find text in column in one sheet and copy row data to another sheet

I have a spreadsheet with customer information that I want to search on by last name. I want to enter the last name on a separate sheet (Sheet 1) and have the macro search the Last Name column in the customer data spreadsheet (Sheet 2). When it finds a match, I want it to copy the entire row in Sheet 2 and paste it to a specific row in Sheet 1. I've searched a number of sites and tried numerous versions of code but cannot get it to work.
Here's a link that shows you how to get data from another sheet or workbook. Basically you use Sheet_name!Cell_address or Sheet_name!First_cell:Last_cell.
Hope this helps :)
I think this sounds simple enough, loop until you find the value you want. How do you want the trigger to fire? the below into sheet 2 into the will trigger after double clicking on a selected cell in column 1, will prompt you for input, then copy the first match.
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 1 Then Exit Sub 'or which ever column you enter for
Dim str_Act, str_Test As String
Dim i As Integer
'find value to search
str_Act = InputBox("Enter User Last Name")
If str_Act = "" Then Exit Sub
'loop to find search
Do While str_Act <> str_Test
str_Test = Sheets(1).Range("A1").Offset(i, 0) ' or whichever column has your value
i = i + 1
Loop
'Copy and paste
Sheets(1).Range("A1:ZZ1").Offset(i - 1, 0).Copy
Target.PasteSpecial
End Sub

Excel VBA insert row and copy data on multiple sheets

I am trying to get the correct VBA code that will allow me to insert a row in to a filtered table at the same place on multiple worksheets and copy all of the content from the entire row above.
There is a check box relating to each sheet in the workbook. If the check box is ticked then the row should be inserted in to this sheet.
The sheets are password protected. The password is found in another of the worksheets in the file.
I have almost got this to work. My file can be found at the following location:
https://drive.google.com/file/d/0B5HnHgSNFkFid0gwbDNMOFN1NUU/view?usp=sharing
The code is as follows:
Sub Insert_Rows()
Dim sh As Worksheet
For Each sh In Sheets
If sh.Name = "Sheet1" And Worksheets("Sheet4").Range("D1").Value = True Or _
sh.Name = "Sheet2" And Worksheets("Sheet4").Range("D2").Value = True Or _
sh.Name = "Sheet3" And Worksheets("Sheet4").Range("D3").Value = True Then
With sh
.Unprotect Password:=Worksheets("Sheet4").Range("A1")
.Cells(ActiveCell.Row, 4).EntireRow.Insert
.Range(.Cells(ActiveCell.Row, 1), .Cells(ActiveCell.Row, 4)).FillDown
.Protect DrawingObjects:=True, contents:=True, Scenarios:=True, Password:=Worksheets("Sheet4").Range("A1")
End With
End If
Next sh
End Sub
The issue I am having is that not all of the data from the row above is being copied. The data in the 5th column is not copying down. I am sure it is something to do with the 4 in the code .Cells(ActiveCell.Row, 4). I want it to copy the entire row above regardless of the number of columns.
Any help greatly appreciated.
Thanks
To FillDown the EntireRow, instead of just the Range between column 1 and column 4, replace
.Range(.Cells(ActiveCell.Row, 1), .Cells(ActiveCell.Row, 4)).FillDown
with
.Cells(ActiveCell.Row, 1).EntireRow.FillDown
(which could also be written as .Rows(ActiveCell.Row).FillDown)
Note:
Please remember that ActiveCell.Row is not necessarily referring to any special location on Sheet1, Sheet2, or Sheet3.
If the currently active cell is cell G67 on sheet Sheet4, then ActiveCell.Row will evaluate to 67 and so row 66 of Sheet1 (and/or Sheet2 and/or Sheet3) will be copied to a newly inserted row on Sheet1 (and/or Sheet2 and/or Sheet3) - it won't magically decide to insert row 58 on Sheet1 and row 82 on Sheet2, etc.
If the only problem you are having is that the entire row is not being filled down, then the solution above will fix it. But if you find that the wrong row is being filled down, then you will need to rethink how you are selecting the row.

updating column and row values of the list which has duplicate values

I have merged variable amount of worksheets which are called anything includes the word "data" through this code;
Dim masterSheet As Worksheet
Set masterSheet = Sheets("Komko")
'Variable to save the used Range of the master sheet
Dim usedRangeMaster As Integer
Dim ws As Worksheet
'loop through each worksheet in current workbook
For Each ws In Worksheets
'If sheetname contains "data" (UCase casts the Name to upper case letters)
If InStr(1, UCase(ws.Name), "DATA", vbTextCompare) > 0 Then
'calculate the used range of the master sheet
usedRangeMaster = masterSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
'Variable to save the used Range of the sub sheet
Dim usedRangeSub As Integer
'calculate the used range of the sub sheet
usedRangeSub = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
'copy relevant range from the subsheet
ws.Range("C1:C" & usedRangeSub).Copy
'paste the copied range after the used range in column a
masterSheet.Range("A" & usedRangeMaster).PasteSpecial
End If
Next ws
This code copies the C column of the "data" including Sheets and then pastes it to my master Sheets( which is called "Komko") Column A. Now i would like identify the same values in Column C and delete the complete row of the previous matching value. (e.g if C1 has value "123" and if C7 has value "123" the whole row which includes C1 should automatically be deleted)
How can i do this ?
See http://analysistabs.com/vba/find-duplicate-values-column/ to find your duplicate entries and Delete a row in Excel VBA to get some ideas how to delete the row in a good way.
Start searching after you merged your column C. Use a Boolean variable to skip the first found entry if necessary. Replace the code Cells(iCntr, 2) = "Duplicate" from the first link and put your way of deleting the row there.

VBA Code for Conditional Copying of Columns Not Adjacent to each other

Project Master
In MS Excel using VBA, I would like some help on conditional copying between worksheets within the same workbook. As per the attached image, I have a master list of projects on the worksheet "Master". For all the projects that have a "yes" in column I (Defect), I would like to copy the values in columns A (Works Package Issue Date), B (Project No.), E (City) and H (Contract Value) to another worksheet "Defects", within the same workbook.
Can you please provide a coding which could:
a) collapse all the rows so there is no blank rows in "Defects" worksheet; and
b) leave all the rows so if the "Defect" column has a "No", the relevant row from the "Master" worksheet is copied as a blank row in the "Defect" worksheet,
if possible.
Please help me with the coding - I have very basic knowledge of macros, and in a process of learning how to code.
Thanks & Regards, CK
Sub CopyValues()
'Declare variables
'Declare sheet variables
Dim Masterws as Worksheet
Dim Defectws as worksheet
'Declare counter variables
Dim I as Integer
Dim n as Integer
'Set value of sheet variables
Set Masterws=ThisWorkbook.Sheets("Master")
Set Defectws=ThisWorkbook.Sheets("Defects")
'Set value of counter to track first available row on Defects sheet
n=1
'Start a For loop to check each row on Master sheet, starting with row 2
For I = 2 to WorksheetFunction.CountA(Masterws.Columns.EntireColumn(1))
'If the cells in row I, column I have a value of, "Yes," then execute some code. If not, continue on.
If Cells(I, "I").value= "Yes" Then
'Set the value of cells in row n of the Defects sheet to the corresponding values of row I in the Master sheet. If n is replaced with I, then the value of cells in row I on Defects will be set to the values of Row I on Master, leaving blank rows where no, "Yes," was found because no copying took place.
Defectws.Cells(n,"A").Value=Masterws.cells(I,"A")
Defectws.Cells(n,"B").Value=Masterws.cells(I,"B")
Defectws.Cells(n,"C").Value=Masterws.cells(I,"E")
Defectws.Cells(n,"D").Value=Masterws.cells(I,"H")
'Add 1 to the n counter. The next time a row is found in the Master sheet with, "Yes," it will be written to the next available row down on the Defects sheet.
n=n+1
End If
'End of the For loop. Move on to the next row on Master sheet
Next
End Sub

How can I copy & paste entire rows with distinct values to a new sheet on varying cell ranges?

I know there's many StackOverlow Q&A's on copying & pasting from a cell value in VBA. However, I can't seem to make it work for my own project. I want to copy the entire row(s) if it matches the Distinct Store# (non incremental) in Column H into a new sheet (in this code below, "Sheet1") which already has a template layout where I copy/paste the values. The template looks the same on every sheet before any data is filled in, except the first 2 tabs which have the data ("Appointments" and "Invoices").
I came up with the VBA below, but here's the catch- the cell# that it pastes the row(s) (in the code below, "A10") changes based on the Store #. This is because I am copying rows from the 1st sheet ("Appointments") in the workbook from the distinct Store#, then deleting the empty rows above the area where the 2nd sheet ("Invoices") data goes. Some stores may return 10 rows or none at all. The Case, which is the Store #, is currently manually put in one by one. Should it be an array instead?
Anyway...I was hoping to automate the copying/pasting and loop for each store to their sheet. Maybe I'm going about this wrong, but would anyone be kind enough to suggest how to solve my error code "Method or data member not found." as well as provide any suggestions on making my code better for a loop for filtered cell copying to different spots for each sheet.
Simple explanation of my step by step process:
1.Filter Store # from "Appointments" sheet.
2. Copy all rows for that store and paste into a new sheet with template named "Sheet1" in B3.
3. Filter Store # from "Invoices" sheet.
4. Copy all rows for that store and paste into the previously made sheet named "Sheet" under the above rows. (Some stores do not have invoices, so this section is blank/NULL). Paste destination cell for "Invoices" will be different for each store# depending on how many rows they get from the "Appointments" sheet (could be A10 or A25).
5. LOOP- Next store #, next sheet (sheet2).
Sub CopyToNewSheetInv()
Dim i As Range
Dim book As Workbooks
Dim sheet1 As Worksheets
Dim sheet2 As Worksheets
Set book = Workbooks("SampleWorkbookName")
Set sheet1 = Worksheets("AllInvoices")
Set sheet2 = Worksheets("Sheet1")
For Each i In sheet1.Range("H:H")
Select Case i.Value
Case 1243
sheet2.Range("A10").End(xlUp).Offset(1, 0).EntireRow.Value = i.EntireRow.Value
Case Else
End Select
Next i
End Sub
Try this:
Sub CopyToNewSheetInv()
Dim i As Range
Dim book As Workbook
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Set book = Workbooks("SampleWorkbookName.xlsx")
Set sheet1 = book.Worksheets("AllInvoices")
Set sheet2 = book.Worksheets("Sheet1")
'iterate only thorugh those cells in H that have data, not all 1.04 million
For Each i In sheet1.Range("H1", sheet1.Range("H" & sheet1.Rows.Count).End(xlUp))
Select Case i.Value
Case 1243,"1243"
sheet2.Rows(sheet2.Range("A10000").End(xlUp).Offset(1, 0).Row).Value = sheet1.Rows(i.Row).Value
Case Else
End Select
Next i
End Sub