none
First time programmer needing help RRS feed

  • Question

  • Here's what I'm looking for: simple advice as to write a program for the following situation

    I have a worksheet1 columns A-E

    I want to copy row 1 columns A-E worksheet1 to row 1 columns A-E worksheet2

    then I want to compare row 2 column A worksheet1 to row 1 column A worksheet2 and if matched

    then put row 2 column E worksheet1 in place of row 1 column E worksheet2 IF

    row 2 coumn E Worksheet1 is greater than row 1 coulumn E worksheet2 otherwise

    copy row2 coulmns A-E worksheet1 to row2 columns A-E worksheet2

    then continue to end of rows for worksheet1

    Visually:

    1       A       B     C      D     E

          milk      2      3     4     5

          Eggs     12    13    14    15

         Bread    22    33    44    55

        Milk          2     3     4     60

    therefore final would look like:

    1       A       B     C      D     E

          milk      2      3     4     60

          Eggs     12    13    14    15

         Bread    22    33    44    55

     

    Wednesday, July 27, 2011 3:47 PM

All replies

  • Sub Macro1()
    
    Dim myR As Long
    
    Dim myC As Range
    
    With Sheets("Sheet1")
    
     myR = .Cells(Rows.Count, 1).End(xlUp).Row
    
     .Range("F1:F" & myR).FormulaR1C1 = "=SUM(RC[-4]:RC[-1])"
    
     .Range("G1").FormulaArray = "=RC[-1]=MAX(IF(R1C1:R" & myR & "C1=RC[-6],R1C6:R" & myR & "C6))"
    
     .Range("G1").AutoFill Destination:=.Range("G1:G" & myR)
    
     For Each myC In .Range("G1:G" & myR)
    
      If myC.Value Then myC.Offset(0, -6).Resize(1, 5).Copy _
    
       Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)(2)
    
     Next myC
    
     .Range("F1:G" & myR).Clear
    
    End With
    
    End Sub

    Try that. I have assumed that your sheet names are Sheet1 and Sheet2.

     


    HTH, Bernie
    • Proposed as answer by Rafoliveira Friday, July 29, 2011 4:45 PM
    Thursday, July 28, 2011 3:13 PM