Copying one sheet to another workbook based on one criteria - vba

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.

Related

Filter and copy certain rows from multiple excel sheets to another

I am using a workbook that has various sheets. I want to copy all the rows from the last 5 sheets that have the value "Pending" in their column "J". I want to create a new tab named "Pending week" and paste all these rows there. Any help would be really appreciated.
Thanks
You can create this yourself very easily if you just break it down:
Add a new Sheet
Name the sheet to Pending Week
Find the five latest sheets.
Create some kind of loop that copy paste row if cells in column J contains the value "Pending"
You have not provided any code, so I'll give you a base to work from:
You add a new sheet & name it using:
Worksheets.Add
ActiveSheet.Name = "Pending week"
Find the five latest sheets
To my knowledge, you can't find the latest sheets. Sheets doesn't contain the date and time of when they were created. But if we ignore that and expect the five latest sheets to be placed in the workbook to the far most right (Default position for newly created sheets). Then you need to figure out how many sheets you have and count backwards.
You can use: Worksheets.Count to count all the sheets. Use this number and count it backwards. My first thought would be to use a For Loop
Dim X As Integer
For X = (Worksheets.Count - 4) To Worksheets.Count
Next
X would be the identifier to find our latest sheets. So you should incorporate that into our loop below. You want to place the loop within this For Block.
Loop
There are many ways to find a value in a sheet, but you need to figure out what the last row of your sheets are. Without it we don't know when the code should stop.
You can use a Do Until Loop if there is a value in all J cells. Then you can simply insert the entire row into Pending week
It would look something like:
Dim XLrow As Integer
XLrow = 1
Do Until Worksheets(1).Cells(XLrow, "J") = ""
If Worksheets(1).Cells(XLrow, "J") = "Pending" Then
Worksheets(1).Range(XLrow & ":" & XLrow) = Worksheets("Pending week").Cells(XLrow, "J").Value
End If
XLrow = XLrow + 1
Loop
You will need to change the Range to the length of the range you want to copy. Note: the value Pending is case sensitive, so keep that in mind.
Alright, this is what you need to create your code. Of course you need to change values to fit your own workbook, but this is the base.

Copy Column and Paste in the same worksheet a variable number of times

I am going mad trying to do the simplest thing in VBA.
I want to automate the copying of Column C on a worksheet a variable number of times to the adjacent columns D, E, F...etc. of the same worksheet.
Stepping through the code, I have it copying the correct column ("C:C") but cannot get it to paste via Paste, Offset or Destination to column D etc. for the variable number of instances.
this is the code I'm using. Assume all the Dim and Set statements are done as it's a small part of larger Sub.
sht02AnalysisSummary.Activate
For i = 0 To AddCol
i = i + 1
lLastCol = sht02AnalysisSummary.Range("C3").End(xlToLeft).Column
rangeCopy.Copy
Column.Offset("0,lLastCol+i").Paste
Next i
sht01CoverPage.Activate
This sort of works now but with AddCol set at 3, the result is skipping Column D and only repeating the pasting once (into Column E) whereas it should be pasting into D,E & F. Any pointers will be much appreciated.
Do not manually code your iteration var in a For ... Next; you will be disrupting the built-in iteration and progression.
The xlToLeft leaves me confused about the destination (or is it source...?). Perhaps that should be xlToRight or your should start further right before starting to look to the left ?
you should be able to paste a single column into three consecutive destination columns at once.
AddCol = 3
with sht02AnalysisSummary
set rangeCopy = .range(.cells(3, "C"), .cells(.rows.count, "C").end(xlup))
rangeCopy.Copy destination:=.Cells(3, .columns.count).End(xlToLeft).resize(rangeCopy.rows.count, AddCol)
end with
This should work:
Sub CopyPaste()
Dim sht As Worksheet
Set sht = Worksheets("Sheet1")
With sht
.Columns(3).Copy .Columns(4)
End With
End Sub

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

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

VBA. Comparing values of columns names in two separate worksheets, copy nonmatching columns to third worksheet

So, I've explored a few answered VBA Questions, but I'm still stuck. I have three sheets "By_Oppt_ID", "Top_Bottom" and "Non_Top_Bottom". The first two have a large amount of columns each with a unique name. Now there are some columns in By_Oppt_ID that aren't in "Top_Bottom". So I want to compare each column name in By_Oppt_ID to every column name in "Top_Bottom", and if the column name isn't found, copy that column name and all the rows beneath it, to a third worksheet "Non_Top_Bottom".
So Here's what I have:
Sub Copy_Rows_If()
Dim Range_1 As Worksheet, Range_2 As Worksheet
Dim c As Range
Set Range_1 = Workbooks("Complete_Last_Six_Months_Q_Results.xlsx").Sheets("Top_Bottom")
Set Range_2 = Workbooks("Complete_Last_Six_Months_Q_Results.xlsx").Sheets("By_Oppt_ID")
Application.ScreenUpdating = False ' Stays on the same screen even if referencing different worksheets
For Each c In Range_2.Range("A2:LX2")
' Checks for values not in Range_1
If Application.WorksheetFunction.CountIf(Range_1.Range("A1:CR1"), c.Value) = 0 Then
' If not, copies rows to new worksheet
' LR = .Cells(Row.Count, c).End(xUp).Row
c = ActiveCell
Sheets("By_Oppt_ID").Range("Activecell", "ActiveCell.End(xlDown)").Copy Destination:=Workbooks("Complete_Last_Six_Months_Q_Results.xlsx").Sheets("Non_Top_Bottom").Range("A1:A6745")
Set rgPaste = rgPaste.Offset(0, 1) 'Moves to the next col, but starts at the same row position
End If
Next c
End Sub
I've compiled this many ways and keep getting a series of errors: Subscript Out of Range/ Method "Global_Range" Failure. What am I doing wrong?
If you are going to have this code within the same workbook every time, try using
ThisWorkbook.Sheets("Top_Bottom")
instead of
Workbooks("Complete_Last_Six_Months_Q_Results.xlsx").Sheets("Top_Bottom")
replicate that through your code and see if that fixes the problem.
What do you mean by c = Activecell? Do you mean to say c.activate?
You might then also want to change the next line to
Sheets("By_Oppt_ID").Range(Activecell, ActiveCell.End(xlDown)).Copy Workbooks("Complete_Last_Six_Months_Q_Results.xlsx").Sheets("Non_Top_Bottom").Range("A1")