Paste data in to column depending on Heading

Godders199

Active Member
Joined
Mar 2, 2017
Messages
313
Office Version
  1. 2013
Hello, I have been searching the internet, but cannot find what i am looking to do.

I have a spreadsheet with columns A to R.

the relevant columns are A - Client name
Q- Enhanced - will return ever 0 or 1
R - Calulates which Quarter we are in.

I am looking for the VBA to do the following

If Q = 1 then copy contents of column A into a sheet "names" into the relevant column , Q1,Q2,Q3,Q4 depending on the value in column R on sheet 1

Hope this mankes sense.

If anyone can help will be appreciated.
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Hello, update on this

I have worked out the following code, but it is stuck in a loop, when i interupt the code it is on Selection.copy does anyone no why the vba will not finish after it has pasted the data into the column.
Sub enhanced()
Sheets("checks").Select
ActiveSheet.Range("$A$2:$BJ$2000").AutoFilter Field:=20, Criteria1:="1"
For Each cell In Range("v:v")
If cell.Value = "q4" Then
Range("a3:a2000").Select
Selection.Copy
Sheets("enhanced history").Select
Range("d2").Select
ActiveSheet.Paste
Sheets("checks").Select
Range("a1").Select
Application.CutCopyMode = False
End If
Next
For Each cell In Range("v:v")
If cell.Value = "q3" Then
Range("a3:a2000").Select
Selection.Copy
Sheets("enhanced history").Select
Range("c2").Select
ActiveSheet.Paste
Sheets("checks").Select
Range("a1").Select
Application.CutCopyMode = False
End If
Next
For Each cell In Range("v:v")
If cell.Value = "q2" Then
Range("a3:a2000").Select
Selection.Copy
Sheets("enhanced history").Select
Range("b2").Select
ActiveSheet.Paste
Sheets("checks").Select
Range("a1").Select
Application.CutCopyMode = False
End If
Next
For Each cell In Range("v:v")
If cell.Value = "q1" Then
Range("a3:a2000").Select
Selection.Copy
Sheets("enhanced history").Select
Range("a2").Select
ActiveSheet.Paste
Sheets("checks").Select
Range("a1").Select
Application.CutCopyMode = False
End If
Next

End Sub
 
Upvote 0
There seem to be some discrepancies between the information you gave in your posts. In Post #1 , you mention columns Q and R. In Post #2 , the quarter seems to be in column V and the Enhanced seems to be in column T. The sheet names are also not consistent. Could you please clarify. Be specific and list the actual sheet names involved. It looks like your column headers are in row 2 on all sheets. Is this true? When you say
relevant column , Q1,Q2,Q3,Q4
are these the column headers in row 2?
 
Upvote 0
HI Mumps
Sheet Names are Checks - Where all data is created, enhanced checks - where i want to paste the information into.
within enhanced checks , Q1,Q2,Q3,Q4 are column headers in A,B,C,D

Within Sheet Checks, the columns used are

V = to obtain the Quarter
T = to filter for rows with 1 in the cell
A = the data to be copied into the enhanced check sheet

The code above does seem to work as I can see the data in the enhanced sheet when i stop the marco. The problem is that it just appears to be stuck in a loop, as I can see the two sheets constantly flashing until i escape out of the marco.
 
Upvote 0
Give this a try:
Code:
Sub enhanced()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("checks").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim cell As Range
    Sheets("checks").Range("A2:BJ" & LastRow).AutoFilter Field:=20, Criteria1:="1"
    For Each cell In Range("V3:V" & LastRow).SpecialCells(xlCellTypeVisible)
        Select Case cell.Value
            Case "q4"
                Range("A3:A" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("enhanced history").Range("D2")
            Case "q3"
                Range("A3:A" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("enhanced history").Range("C2")
            Case "q2"
                Range("A3:A" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("enhanced history").Range("B2")
            Case "q1"
                Range("A3:A" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("enhanced history").Range("A2")
        End Select
    Next cell
    If Sheets("checks").FilterMode Then Sheets("checks").ShowAllData
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thanks for the code,

While it runs with out Debugging , it does not return any results to the enhanced history tab.

I am still learning VBA , but cannot see where in the code it pastes the results into the relevant column.. Is it the copy sheets command?
 
Upvote 0
The cell values are case sensitive. The macro looks for "q1" as you had in your code in Post #2 not "Q1". Make sure the values in the macro match the values in column V. If this is not the problem, perhaps you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data. Each line of code below the 'Case' line does the copy/paste.
 
Upvote 0
Does this work for you?
Code:
Sub CopyFltr()

    Dim Usdrws As Long
    Dim Arr As Variant
    Dim Val As Variant
    
    Arr = Array("q1", "q2", "q3", "q4")
    With Sheets("checks")
        Usdrws = .Cells.Find("*", After:=.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        
        For Each Val In Arr
            .Range("A2:BJ" & Usdrws).AutoFilter Field:=20, Criteria1:="1"
            .Range("A2:BJ" & Usdrws).AutoFilter Field:=22, Criteria1:=Val
            .Range("A3:A" & Usdrws).SpecialCells(xlVisible).Copy Sheets("enhanced history").Cells(2, CLng(Right(Val, 1)))
        Next Val
        .Range("A2").AutoFilter
    End With
    
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,765
Messages
6,180,844
Members
453,001
Latest member
coulombevin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top