Excel macro to copy paste values of certain range based on a certain condition

[rahulbids]

Hi all,

I require valuable help for creating a macro.

I have data in a worksheet (say sheet 1) from I4 to U1000. The headings are in I4:U4 and there are formulas in I5 to I1000 and J5 to J1000. Users enter data from column K to U row 5 onwards.

Now i want a macro which does the following:

1) As soon as users enter "Submitted" in col R and some value in col S - example R10 = Submitted and S10 = Value - the macro should select the range I4:U10 [I4 is top of table and U is the last column which has data and U10 since user enter the data in 10th row in example which i am providing]

2) The macro should then copy the range I4:U10 and past special values in the same range.

The next time when users enter data in say R15 (=Submitted) and S15 (=any value) the macro should work again and select the range I4:U15 and copy paste values in the same range.

Thank you all for any help provided.

Best regards,
Rahul

 

[sijpie]

Let me rephrase what you want. Please confirm if this is correct.

If a user complets a row by adding a value in Sx and 'Submitted' in Rx then this row and all the rows above need to be fixed by overwriting the formulas with their values (paste as value).

 

[rahulbids]

Let me rephrase what you want. Please confirm if this is correct.

If a user complets a row by adding a value in Sx and 'Submitted' in Rx then this row and all the rows above need to be fixed by overwriting the formulas with their values (paste as value).

Thanks for the comment. Yes, you are correct sijpie That is what i want.

 

[sijpie]

OK. Read carefully, I don't know what your macro knowledge is:
in Excel with your sheet pen, press Alt-F11 to open the macro editor.
Now in the left side of the macro editor you will see your spreadsheet mentioned, and you can see the name of all the sheets in the workbook. As we want this macro to check every time a user makes a change to the sheet, we need to add the macro to the sheet object itself. So double-click on the sheet name in the left hand panel. A white (main) panel opens to the right. Here is wher we can enter the macros.
Copy and paste the following macros into this panel:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Intersect(Target, Range("R:S")) Is Nothing Then
        Select Case Target.Column
            Case Range("R1").Column
                If Target.Offset(0, 1) <> vbNullString And _
                 LCase(Target.Value) = "submitted" Then
                    fixTable Target.Row
                End If
            Case Range("S1").Column
                If Target.Value <> vbNullString And _
                 LCase(Target.Offset(0, -1).Value) = "submitted" Then
                    fixTable Target.Row
                End If
        End Select
    End If
End Sub


Sub fixTable(lRow As Long)
    Range("I1:U" & lRow).Value = Range("I1:U" & lRow).Value
End Sub

That's it!

What the macro does is: it checks if the user has entered anything in the columns R:S. If not nothing happens. IF yes then it will check if there is a value in the S cell of that row, and "Submitted" in the R cell of that row. If so it calls a short function to fix the table above and including this row. in case you wonder: 'Target' in the macro is the cell that has just been changed.

 

[rahulbids]

Thank you very much Sijpie...it worked wonders...

I just realized the users also need to enter something in last two columns and hence i tried modifing your code to include column T and U. Here is what the code looks like

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Intersect(Target, Range("R:U")) Is Nothing Then
        Select Case Target.Column
            Case Range("R1").Column
                If Target.Offset(0, 1) <> vbNullString And _
                 LCase(Target.Value) = "submitted" Then
                    fixTable Target.Row
                End If
            Case Range("S1").Column
                If Target.Value <> vbNullString Then
                    fixTable Target.Row
                End If
            Case Range("T1").Column
                If Target.Value <> vbNullString Then
                    fixTable Target.Row
                End If
            Case Range("U1").Column
                If Target.Value <> vbNullString Then
                    fixTable Target.Row
                End If
        End Select
    End If
End Sub




Sub fixTable(lRow As Long)
    Range("I1:U" & lRow).Value = Range("I1:U" & lRow).Value
End Sub

But it is bypassing last 2 columns - no error message though - could you please help.
Thank you once again for your help.

Best regards,
Rahul

 

[rahulbids]

I figured it out...this code seems to be working. However, would like your expert opinion in trimming this code!

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Intersect(Target, Range("R:U")) Is Nothing Then
        Select Case Target.Column
            Case Range("R1").Column
                If Target.Offset(0, 1) <> vbNullString And _
                 LCase(Target.Value) = "submitted" Then
                End If
            Case Range("S1").Column
                If Target.Value <> vbNullString And _
                 LCase(Target.Offset(0, -1).Value) = "submitted" Then
                End If
            Case Range("T1").Column
                If Target.Value <> vbNullString And _
                 LCase(Target.Offset(0, -2).Value) = "submitted" And _
                 LCase(Target.Offset(0, -1).Value) <> vbNullString Then
                End If
            Case Range("U1").Column
                If Target.Value <> vbNullString And _
                 LCase(Target.Offset(0, -3).Value) = "submitted" And _
                 LCase(Target.Offset(0, -2).Value) <> vbNullString And _
                 LCase(Target.Offset(0, -1).Value) <> vbNullString Then
                    fixTable Target.Row
                End If
        End Select
    End If
End Sub




Sub fixTable(lRow As Long)
    Range("I1:U" & lRow).Value = Range("I1:U" & lRow).Value
End Sub

Best regards,
Rahul

 

[rahulbids]

My extreme apologies for posting so many codes. But i could further trim down the above code to following. It is still working. Thank you very much Sijpie!

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Intersect(Target, Range("R:U")) Is Nothing Then
        Select Case Target.Column
            Case Range("R1").Column
                If Target.Offset(0, 1) <> vbNullString And _
                 LCase(Target.Value) = "submitted" Then
                End If
            Case Range("U1").Column
                If Target.Value <> vbNullString And _
                 LCase(Target.Offset(0, -3).Value) = "submitted" And _
                 LCase(Target.Offset(0, -2).Value) <> vbNullString And _
                 LCase(Target.Offset(0, -1).Value) <> vbNullString Then
                    fixTable Target.Row
                End If
        End Select
    End If
End Sub

Sub fixTable(lRow As Long)
    Range("I1:U" & lRow).Value = Range("I1:U" & lRow).Value
End Sub

This ends my first part of requirement. My second part is to automatically sort the data within this range. But i guess i need to open a new thread for this new question. I will provide a link to this post for my new thread. I will also try to post and example worksheet to help.
I look forward to further help.

Thanks and regards,
Rahul