Copy specific cells to other cells based on conditions using VBA

Question

I am completely self-taught and that I have no idea what I am doing. I am trying to create a VBA macro to search 2 different cells for a condition, and then if it is true copy data in cells from a worksheet to another worksheet.

I have been piecing together code based on what I have learned online. How can I get this to work?

What I am trying to do:

Open “sept daily report”, open page “CM PROC”
IF cell  (“AJ”) = today   AND cell (“AM”) = “con”  THEN
Copy/ past From “cm pro” to “info”
Start on “A3” on “info” sheet
“AH” to “A”
“K” to “B”
“N” to “C”
“O” to “D”
“P” to “E”
“Q” to “F”
“AJ” to “G”
“S” to “H”
“T” to “I”
“U” to “J”
“Y” to “L”
“AB” to “M”
Close “sept daily report”

Here's what I have so far, but no luck.

Sub Macro4()
'
' Macro4 Macro
'
    Dim LastRow As interger, i As Integer, errow As interger

    Workbooks.Open Filename:= _

        "S:\OPS\FY17 FILES\Daily Report\September Daily Report.xlsx", UpdateLinks:=0
    Sheets("CM Proc").Select
    LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To LastRow
    If Cells("AJ") = mydate And Cells("AM") = "con" Then
    erow = ActiveSheet.Cells(Row.Count, 2).End(xlUp).Offset(1, 0).Row
    Sheets("CM Proc").Select
    Windows("September Daily Report.xlsx").Activate
    Range("O").Select
    Selection.Copy
    Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate
    Range("D").Select
    ActiveSheet.Paste
    Windows("September Daily Report.xlsx").Activate
    Range("P").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate
    Range("E").Select
    ActiveSheet.Paste
    Windows("September Daily Report.xlsx").Activate
    Range("Q").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate
    Range("F").Select
    ActiveSheet.Paste
    Windows("September Daily Report.xlsx").Activate
    Range("S").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate
    Range("H").Select
    ActiveSheet.Paste
    Windows("September Daily Report.xlsx").Activate
    Range("N").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate
    Range("C").Select
    ActiveSheet.Paste
    Windows("September Daily Report.xlsx").Activate
    Range("K").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate
    Range("B").Select
    ActiveSheet.Paste
    Windows("September Daily Report.xlsx").Activate
    Range("AH").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate
    Range("A").Select
    ActiveSheet.Paste
    Windows("September Daily Report.xlsx").Activate
    ActiveWindow.SmallScroll ToRight:=3
    Range("AJ").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate
    Range("G").Select
    ActiveSheet.Paste
    Windows("September Daily Report.xlsx").Activate
    Range("T").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate
    Range("I").Select
    ActiveSheet.Paste
    Windows("September Daily Report.xlsx").Activate
    Range("U").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate
    Range("J").Select
    ActiveSheet.Paste
    Windows("September Daily Report.xlsx").Activate
    Range("Y").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate
    Range("L").Select
    ActiveSheet.Paste
    Windows("September Daily Report.xlsx").Activate
    Range("AB").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("CONTRACT TAG CREATOR MACRO PROJECT.xlsm").Activate
    Range("M").Select
    ActiveSheet.Paste
    Windows("September Daily Report.xlsx").Activate
    ActiveWindow.Close
End Sub

Is VBA required? Why not a [two column lookup formula](https://stackoverflow.com/questions/33010190/two-column-lookup-in-table-array-using-index-and-match/33011266#33011266)? — , Sep 17 '17 at 18:00
btw, it is **integer** not **interger** and you should be dimming those as `Long` in any event. — , Sep 17 '17 at 18:06
as per @Jeeped, an `integer` has a maximum value of 32767 .... also, if you type in `integer` then VBA editor changes it to `Integer` (capital `I`) .... if you mistype it then VBA editor does not change anything — jsotola, Sep 17 '17 at 19:47
^ Specify `Option Explicit` at the top of every module, then in the "Debug" menu, select "Compile VBAProject", deal with the compile errors, then [edit] your question accordingly. — Mathieu Guindon, Sep 17 '17 at 19:58

score 1 · Answer 1 · 2017-09-17T18:32:34.717

1

Store the random columns into an organized array and use that array to bring the values into the target workbook's active worksheet.

Option Explicit

Sub Macro5()
    Dim i As Long, xfer As Variant
    Dim wbDR As Workbook, wbCTC As Workbook, wst As Worksheet

    Set wbCTC = Workbooks("CONTRACT TAG CREATOR MACRO PROJECT.xlsm")
    'the above might be easier as ,
    'Set wbCTC = ThisWorkbook   'if that is the workbook containing this code
    Set wst = wbCTC.Worksheets("info")
    Set wbDR = Workbooks.Open(Filename:="S:\OPS\FY17 FILES\Daily Report\September Daily Report.xlsx", _
                              UpdateLinks:=0)
    With wbDR.Worksheets("CM Proc")
        For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            If Int(.Cells(i, "AJ").Value2) = Date And LCase(.Cells(i, "AM").Value2) = "con" Then
                ReDim xfer(1 To 1, 1 To 12)
                xfer(1, 1) = .Cells(i, "AH").Value
                xfer(1, 2) = .Cells(i, "K").Value
                xfer(1, 3) = .Cells(i, "N").Value
                xfer(1, 4) = .Cells(i, "O").Value
                xfer(1, 5) = .Cells(i, "P").Value
                xfer(1, 6) = .Cells(i, "Q").Value
                xfer(1, 7) = .Cells(i, "AJ").Value
                xfer(1, 8) = .Cells(i, "S").Value
                xfer(1, 9) = .Cells(i, "T").Value
                xfer(1, 10) = .Cells(i, "U").Value
                xfer(1, 11) = .Cells(i, "Y").Value
                xfer(1, 12) = .Cells(i, "AB").Value
                With wst
                    .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(UBound(xfer, 1), UBound(xfer, 2)) = xfer
                End With
            End If
        Next i
        'optionally close September Daily Report.xlsx
        'wbDR.close savechanges:=false
    End With
End Sub

See How to avoid using Select in Excel VBA.

edited Sep 17 '17 at 18:32

answered Sep 17 '17 at 18:27

I appreciate the help and the quick reply! I tried using the supplies code, and it is finding and opening the "September daily report", but it will not copy the cells or transfer them over to the new page. I've tried changing the format of the date and ensuring everything was correct, but can not locate the issue on why the conditions are not finding anything. Any ideas on what to check next or what the issue may be? not sure if it matters that its 2 different workbooks. one that i am copying from and the second i am copying into. Thank you for your help! – user8621952 Sep 17 '17 at 19:05
If I could see data I could probably tell you within a few seconds. Consider posting a redacted copy to a public file share and editing your question to include a publicly accessible link. Failing that, you are going to have to determine why your data does not follow the two column criteria match yourself. – Sep 17 '17 at 19:10
btw, you realize that I changed `mydate` to `Date` (i.e. today's date as per your narrative) don't you? I did this because you stated *'IF cell (“AJ”) = today'* in your description of the criteria. Today is Sunday for me so perhaps you have no matching dates. – Sep 17 '17 at 19:12
I did catch the date, and went back into the report to ensure that the date had today's date on it as well (date is displayed as 9/17/2017). I also changed it to "CON" in the formula in case it is case sensitive. so it looks like its either not finding a value or not copying/ pasting. Is there a way to show where it is stopping? I'm not sure what you would need to see, or how to post it for you look at it. – user8621952 Sep 17 '17 at 19:25
The *con* should be left alone. Yes it is case-sensitive comparison but I used `LCase` to convert any `CON` or `Con` to `con` before the comparison. I also used `Int` on the date to convert any date-with-time to just the date. – Sep 17 '17 at 19:30
Put it on google drive or MS's one drive or dropbox and make sure it is publicly accessible then create a link and post the link back here. – Sep 17 '17 at 19:31
Ok, I'll change it back. I appreciate all the help as this is all new to me. – user8621952 Sep 17 '17 at 19:33
I am trying to find a way to put it online, but the file it is pulling from wont work because it is located on a server elsewhere. What information would you need to see to be able to help me with diagnosing the problems? – user8621952 Sep 17 '17 at 19:56
I appreciate all the help. I think this is above my level though. I'm going to try to find another way to get the information to copy over automatically. Thank you again! – user8621952 Sep 17 '17 at 20:31

Copy specific cells to other cells based on conditions using VBA

1 Answers1