I have a 3 column table in excel named "RFQ_selector". The 2nd column contains yes/no.
I need a macro that will filter the table for only rows that contain 'Yes' in the 2nd column.
Then the macro should copy every cell to the left of a row which contains a yes into a new location on the same sheet. Pasting them in a list starting at cell F25
I'm getting stuck, can someone help please.
Thanks
Sub CopyYes()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Trader")
Set Target = ActiveWorkbook.Worksheets("Sheet2")
j = 1 ' Start copying to row 1 in target sheet
For Each c In Source.Range("C8:C22") ' Do 30 rows
If c = "yes" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
End Sub
I've modified your sub to reflect your desired changes:
Copy every cell to the left of a row which contains a yes into a new location on the same sheet. Pasting them in a list starting
at cell F25
It does not filter, there was no filtering happening in your provided code but the output only includes information for the "Yes" columns
Sub CopyYes()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
'Target worksheet not needed, pasting to source worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Sheet1")
j = 25 'Start copying to F25
For Each c In Source.Range("B2:B30") 'Change the range here to fit the range in which your data for Yes/No is stored
If c = "Yes" Then 'Verify capitalization here, difference between "Yes" and "yes"
c.Offset(0, -1).Copy Source.Range("F" & j) 'Copy the cell to the left of the Yes/No column and paste on same sheet starting at row F25
j = j + 1
End If
Next c
End Sub
Related
So I need to create a macro that transfers data in specific cells in a column on worksheet 1 to worksheet 2 based on data in a different column in worksheet 1 that meets a specific criteria. Say Worksheet 1 had a column(A) with colors Blue or Green and another column(B) with Apples or Pears (Apples to Blue and Pears to Green). I need to create a macro that will only transfer the Apples that correspond to the color Blue to another column in Worksheet 2.
Sub Update()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Sheet 2")
Set Target = ActiveWorkbook.Worksheets("Sheet1")
j = 1 ' Start copying to row 1 in target sheet
For Each c In Source.Range("D35:D100")
If c = "Blue" Then
Target.Range("C5").Value = Source.Range("B35")
j = j + 1
End If
Next c
End Sub
No matter what I try I cannot get it to only transfer the data that meets the criteria of "Blue". Any help would be greatly appreciated please and thanks!
I'm going to assume you wanted to copy this into Column C of your target worksheet...
Sub Update()
Dim c As Range
Dim j As Long
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Sheet 2")
Set Target = ActiveWorkbook.Worksheets("Sheet1")
j = 1 ' Start copying to row 1 in target sheet
For Each c In Source.Range("D35:D100")
If (c.Value = "Blue" And c.Offset(0.1).Value) = "Apples" Or _
(c.Value = "Green" And c.Offset(0,1).Value = "Pears") Then
Target.Range("C" & j).Value = c.Value
j = j + 1
End If
Next c
End Sub
I have a little code so I can move specific rows to a specific sheet which is structured as follows:
sheet 1 (contains all data)
sheet 2 (the destination sheet of rows to move)
So basically the code looks for a keyword on a specific column, and copies all rows that meet that criteria on the specified column from sheet 1 to sheet 2, it does that like a charm. The problem I have is because of data organization, I need to delete the rows once they have been copied, I tried using the .cut target instead of .copy target, and it works too, but it takes extremely long (about 1+ min), and it looks like that whole time is frozen as it doesn't let you select anything.
Any suggestions to accomplish this more efficiently? I am learning VBA, so please bear with me.
Sub Copydatatoothersheet()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Sheet1")
Set Target = ActiveWorkbook.Worksheets("Sheet2")
j = 3 ' Start copying to row 3 in target sheet
Application.ScreenUpdating = False
For Each c In Source.Range("BB:BB")
If c = "UNPAID" Then
'THIS IS THE LINE WHERE I REPLACE COPY WITH CUT
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
Application.ScreenUpdating = True
End Sub
Try store the desired ranges in a variable then delete the entire rows of that stored range
Sub Copydatatoothersheet()
Dim c As Range
Dim j As Integer
Dim source As Worksheet
Dim target As Worksheet
Dim oRange As Range
' Change worksheet designations as needed
Set source = ActiveWorkbook.Worksheets("Sheet1")
Set target = ActiveWorkbook.Worksheets("Sheet2")
j = 3 ' Start copying to row 3 in target sheet
Application.ScreenUpdating = False
For Each c In source.Range("BB:BB")
If c = "UNPAID" Then
'THIS IS THE LINE WHERE I REPLACE COPY WITH CUT
source.Rows(c.Row).Copy target.Rows(j)
If oRange Is Nothing Then Set oRange = c Else Set oRange =
Union(oRange, c)
j = j + 1
End If
Next c
If Not oRange Is Nothing Then oRange.EntireRow.Delete
Application.ScreenUpdating = True
End Sub
Use AutoFilter
Sub foo()
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Sheet1")
Set Target = ActiveWorkbook.Worksheets("Sheet2")
With Source
With .Range("BB:BB" & .Cells(.Rows.Count, "BB").End(xlUp).Row) 'reference its column BB cells from row 1 (header) down to last not empty one
.AutoFilter field:=1, Criteria1:= "UNPAID"' filter referenced cells on 1st column with "UNPAID" content
If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 1 Then
With .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
Intersect(.EntireRow, .Parent.UsedRange), .Parent.UsedRange).Copy Destination:=Target.Range("A1") ' if any filtered cell other than the header then copy their entire rows and paste to 'Target' sheet starting from its cell A1
.EntireRow.Delete ‘finally, delete these rows
End With
End If
End With
.AutoFilterMode = False
End With
End Sub
You may also add the ScreenUpdating toggling
I have a weekly report that I am running. I have two separate worksheets. In the first worksheet I input my data (a table with 2 columns and unknown number of rows beforehand) and I want to create a macro where I click it and I cut all these data, and move them to the other worksheet. In the worksheet where the table is pasted, I want the data to be pasted as values ( include the initial formulas) and be pasted below the data from the previous week.
e.g. If I cut data from Worksheet1 from cells A1:B7, I want to paste the values in Worksheet2, in cells A7:B14. Next week, the data should be cut-pasted from cells A1:B5 in Worksheet1 to cells A15:B20 in Worksheet2
I have this code so far but I am doing something wrong. I am at a beginner level with vba.
Sub Movetabletototal()
Dim Count As Integer
Dim Table As Range
Dim CountRange As Range
Worksheets("TOTAL").Select
Set CountRange = Range("A2:A1000")
Count = Application.WorksheetFunction.Count(CountRange)
Worksheets("MIXER TOTAL").Select
Set Table = Range("P3:Q12")
Worksheets("TOTAL").Select
Worksheets("TOTAL").Range("A1").Select
ActiveCell.Offset(1, Count + 1).Select
ActiveCell.Value = Table
Worksheets("MIXER TOTAL").Select
Worksheets("MIXER TOTAL").Range("P3:Q12").Clear Contents
If Worksheets("TOTAL").Range("A2").Offset(1, Count) <> "" Then
Worksheets("TOTAL").Range("A2").End(xlDown).Select
End If
End Sub
Thank you!
This code successfully does this:
e.g. If I cut data from Worksheet1 from cells A1:B7, I want to paste
the values in Worksheet2, in cells A7:B14. Next week, the data should
be cut-pasted from cells A1:B5 in Worksheet1 to cells A15:B20 in
Worksheet2
Edit per your comment:
Using P3:Q12 on "MIXER TOTAL" as your data that changes, and pasting to columns A:B on the "TOTAL" sheet after current data.
Sub Movetabletototal()
Dim Count As Integer
Dim copyRng As Range, pasteRng As Range
Dim totalWS As Worksheet, mixerWS As Worksheet
Set totalWS = Worksheets("TOTAL")
Set mixerWS = Worksheets("MIXER TOTAL")
Set copyRng = mixerWS.Range("P3:Q" & mixerWS.Cells(mixerWS.Rows.Count, 17).End(xlUp).Row)
Dim newRow As Long
newRow = totalWS.Cells(totalWS.Rows.Count, 1).End(xlUp).Row
If newRow > 1 Then newRow = newRow + 1
copyRng.Copy totalWS.Range(totalWS.Cells(newRow, 1), totalWS.Cells(newRow + copyRng.Rows.Count, copyRng.Columns.Count))
copyRng.ClearContents
End Sub
Change those ranges as necessary. (Note, currently if your data goes from P3:Q1000, it'll copy all that range. If you strictly want P3:Q12, then change CopyRng to just mixerWS.Range("P3:Q12")
Using VBA, how do I:
Copy cell B1 in Worksheet1 to a new Worksheet2 only if cell A1 (in Worksheet1) value = "YES".
This then repeats for each row in range A1:A1000 (i.e. B2 copies based on A2 value = "YES" and so on) - if cell is blank, check next row.
Sub Output()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Set Source = ActiveWorkbook.Worksheets("worksheet1")
Set Target = ActiveWorkbook.Worksheets("worksheet2")
j = 1 ' Start copying to row 1 in target sheet
For Each c In Source.Range("R2:R1000") ' Do 1000 rows
If c = "YES" Then
Source.Rows(c.Row).Copy Target.Rows(j) /*getting stuck here on trying to copy a cell from column S in worksheet1 to worksheet2
j = j + 1
End If
Next c
End Sub
You just need a quick modification to change from copying the row to the individual cells and location. I used that you are copying from column AG in row c.
Sub Output()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Set Source = ActiveWorkbook.Worksheets("workshee1")
Set Target = ActiveWorkbook.Worksheets("workshee2")
j = 1 ' Start copying to row 1 in target sheet
For Each c In Source.Range("R2:R1000") ' Do 1000 rows
If c = "YES" Then
Target.Cells(j, "A").Value = Source.Cells(c.Row, "AG").Value
j = j + 1
End If
Next c
End Sub
I have this code that will check column E in my xls file and if it is not blank copy the row to a new worksheet. However I can't find how to exclude cells. Columns C, D, E, F, and G and the search columns. If the macro I am running (in this case E) has data in it, I want to copy every cell on the row Except C, D, F, G. Is this possible?
Sub CopyYes()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Sheet1")
Set Target = ActiveWorkbook.Worksheets("Sheet2")
J = 1 ' Start copying to row 1 in target sheet
For Each c In Source.Range("E1:E1000") ' Do 1000 rows
If c <> "" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
End Sub
This is how you can add the delete part in your code:
Sub CopyYes()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Sheet1")
Set Target = ActiveWorkbook.Worksheets("Sheet2")
j = 1 ' Start copying to row 1 in target sheet
For Each c In Source.Range("E1:E1000") ' Do 1000 rows
If c <> "" Then
Source.Rows(c.Row).Copy Target.Rows(j)
With Target
.Range("C" & j).ClearContents
.Range("D" & j).ClearContents
.Range("F" & j).ClearContents
.Range("G" & j).ClearContents
End With
j = j + 1
End If
Next c
End Sub
Let me know if you have any doubts.
Easiest thing to do is to write an array of strings which contain the column/rows that you do not want to copy.
Then write an if statement saying that if the current column/row the code is currently looking at then it should move onto the next section.
Here is how to define an array if you didn't know
Dim DoNotCopy(1 to 10) as ListRows *OR as ListColumns*
There you can define each part of the array as columns/rows
Set DoNotCopy as Sheet("blah").Range("D:D")
Hope this helps!