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

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

Related

Copying one sheet to another workbook based on one criteria

I have 2 different workbooks, main and copy.
Row 1 is meant for header/labeling the information it will be providing for both workbooks.
The "main" workbook will be using columns A to N. The copy will be using columns A to M.
The criteria to determine whether the code will be copying is the workbook, "main", column M.
If the cell contains "X" - it will copy column A to L, and N, to the workbook "copy". After which, it will go on to the next row to determine the same thing.
If the cell is empty, it will proceed down to the next row to determine the same thing as well.
The code has to be dynamic as new information will be added every 3 months, such as new rows added or the criteria changing from "X" to empty, or empty to "X".
I am a beginner in VBA excel, and have been trying out multiple codes but it doesn't seems to work. Would greatly appreciate it if someone could help me out with this.
Showing your code so far will help us a lot.
Maybe this helps a little:
Dim wks As Worksheet
Dim wks_copy As Worksheet
Set wks = Worksheets("main")
Set wks_copy = Worksheets("copy")
j = 2
For i = 2 To wks.UsedRange.Rows.Count
If wks.Cells(i, 13).Value = "x" Then
wks.Range(Cells(i, 1), Cells(i, 14)).Copy Destination:=wks_copy.Cells(j, 1)
j = j + 1
End If
Next i
This will copy the entire row. If you don't want to copy column M, I suggest clearing or hiding the column after copying.
If the macro runs again after 3 months, it will overwrite the existing data on Worksheet copy. But you should delete the worksheet's values before that, for example by using
Worksheets("copy").UsedRange.Offset(1, 0).ClearContents
or manually clearing the range.

Overwrite row data in one sheet with data from a second sheet satisfying 4 conditions

I've looked at several threads and there are some that touch on my problem, however, I've never used VBA and haven't a clue how to change the coding to suit my problem.
I would like to overwrite rows of data on sheet 2 from sheet 1, providing the data in columns A, B, C & D (live data starting row 2) are a match on both sheets 1 & 2.
Essentially sheet 2 is my data store, and sheet 1 is a template of sheet 2. All the possible combinations of data in the first four columns already exist in sheet 2 with the remaining data in the row unknown. So when I get that unknown data, I would like to overwrite that row in sheet 2.
A lot of people have made threads about copying rows over where one specific term is searched for in a column, whereas, I will have many different terms to search for, but as I said, they will need to be a match on both sheets.
Hope I've made sense! Please help!
You may be able to do this with a formula rather than using VBA.
Paste this formula into cell E1 of sheet1 if you have no headers:
=IF(AND(A1=INDEX(Sheet2!A:A,MATCH(A1,Sheet2!A:A,FALSE)),B1=INDEX(Sheet2!B:B,MATCH(B1,Sheet2!B:B,FALSE)), C1=INDEX(Sheet2!C:C,MATCH(C1,Sheet2!C:C,FALSE)),D1=INDEX(Sheet2!D:D,MATCH(D1,Sheet2!D:D,FALSE))),INDEX(Sheet2!E:E,MATCH(A1,Sheet2!A:A,FALSE)),"NO")
Or this one into E2 if you have a header row:
=IF(AND(A2=INDEX(Sheet2!A:A,MATCH(A2,Sheet2!A:A,FALSE)),B2=INDEX(Sheet2!B:B,MATCH(B2,Sheet2!B:B,FALSE)), C2=INDEX(Sheet2!C:C,MATCH(C2,Sheet2!C:C,FALSE)),D2=INDEX(Sheet2!D:D,MATCH(D2,Sheet2!D:D,FALSE))),INDEX(Sheet2!E:E,MATCH(A2,Sheet2!A:A,FALSE)),"NO")
Then drag that across using the little toggle on the bottom right of the cell as far across sheet1 as you want the columns to come in from your sheet2.
Then highlight the whole row you just created and drag the little toggle at the bottom right as far down the sheet as you have data (or try double clicking the toggle to auto fill down).
I tried this on a small set of data and it seems to work so it should work for your larger data set as long as all possible variations of the 4 columns on sheet1 are available on sheet2 with associated data in the following columns.
If you get a result of "NO" in any cell then Excel can't find a row in sheet2 which has the exact combination matching the one on sheet1.
EDIT - UPDATED ANSWER BELOW.
Try this, which is much more likely to work for you.
Sub CopyItOver()
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
For Each c1 In sh1.Range("A1", sh1.Range("A1").End(xlDown))
For Each c2 In sh2.Range("A1", sh2.Range("A1").End(xlDown))
If c2.Value = c1.Value Then
If c2.Offset(0, 1).Value = c1.Offset(0, 1).Value Then
If c2.Offset(0, 2).Value = c1.Offset(0, 2).Value Then
If c2.Offset(0, 3).Value = c1.Offset(0, 3).Value Then
c1.EntireRow.Value = c2.EntireRow.Value
End If
End If
End If
End If
Next c2
Next c1
End Sub

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 to copy entire row from one sheet with specific value to another sheet (in different workbook)using macros

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

Copying values in excel to another sheet, based on other values in the sheet

Ok, the question sounds pretty vague, but i will try to explain.
I am trying to copy certain cell values from one sheet into another sheet. The place it should copy it to, is determined by another value in the same sheet. For example:
Sheet1
4040-5056 ----- 4040-5056v1.7
3409-5793 ----- 3409-5793v4.3
Sheet2
4040-5056
3409-5793
Based on the first values you see, the second column of values in sheet1 should be copied in the corresponding cells in sheet2.
I have no idea how to do this, any help would be appreciated!
Thanks in advance
EDIT:
Sheet1 contains all values that have to be copied to the corresponding nvalues in the other sheets.
The values it has to correspond with are spread over 30 sheets or so, but all in the same document. In every sheet the values the code has to look for are all in the same column, so in every sheet is should look whether the value is the same in column A. VLOOKUP works, but is still a slow option, knowing that is handles over 36.000 rows. What the code should do, is copy the value of column B to one of the other sheets, if the value of column A corresponds with the value of column A in the other sheet.
I hope everyone can understand this explanation.
You can use the VLOOKUP function. No need to use VBA for this.
Sheet 1 :
A B C
1 4040-5056 4040-5056v1.7
2 3409-5793 3409-5793V4.3
3
Sheet 2:
A B C
1 4040-5056 =VLOOKUP(A1;Sheet1!$A$1:$B$2;2;FALSE)
2 3409-5793 =VLOOKUP(A2;Sheet1!$A$1:$B$2;2;FALSE)
3
Cell B1 will display "4040-5056v1.7", cell B2 "3409-5793V4.3"
Note that the last argument to VLOOKUP (here FALSE) is important in your case since the data is unsorted.
Another solution, using pure VBA:
Since there is a strong need for performance, I suggest using a dict object, as hinted in this SO question. The advantage of using a dictionary is that it is very fast to lookup, once it is built. So I expect my code to be very quick in the lookup. On the other hand, it will be slower in accessing the individual cells (through loops) than the builtin VLOOKUP.
Comparative performance, using a reference sheet fof 30'000 entries, and 3 lookup sheets with 30'000 lines each:
VLOOKUP : 600 seconds
VBA / dictionary : 3 seconds
so the performance is 200x better with VBA dictionary in this context.
Note : you have to add a reference to "Microsoft Scripting Runtime" (from the tools->Reference menu of the VBA window)
Note : this solution will not work if the data in the reference sheet is not contiguous, or if there are duplicates.
Sub FillReferences()
Dim dict As New Scripting.Dictionary
Dim myRow As Range
Dim mySheet As Worksheet
Const RefSheetName As String = "sheet1"
' 1. Build a dictionnary
Set mySheet = Worksheets(RefSheetName)
For Each myRow In mySheet.Range(mySheet.Range("A1").End(xlDown), mySheet.Range("A" & mySheet.Rows.Count).End(xlUp))
' Append A : B to dictionnary
dict.Add myRow.Value, myRow.Offset(0, 1).Value
Next myRow
' 2. Use it over all sheets
For Each mySheet In Worksheets
If mySheet.Name <> RefSheetName Then
' Check all cells in col A
For Each myRow In mySheet.Range(mySheet.Range("A1").End(xlDown), mySheet.Range("A" & mySheet.Rows.Count).End(xlUp))
' Value exists in ref sheet ?
If dict.exists(myRow.Value) Then
' Put value in col B
myRow.Offset(0, 1).Value = dict(myRow.Value)
End If
Next myRow
End If
Next mySheet
End Sub