Auto paste selected cells data in other defined excel sheet when I color the selected data


I have attached a Sample Reconciliation sheet. I want selected data to be auto copy pasted from GL to Bank Rec when it is colored i.e. light golden by inserting new rows in Bank Rec sheet. In short I need data to be pasted in Bank Rec Sheet based on its color for GL. Is this possible through VBA?

Please note that this sample is portion of my complete work book but if i got a VBA I would only change range to project it.




I modified the code in your 'Module1' as below.

Option Explicit
Sub WriteToBankRec()
    ' 13 Oct 2017
    Dim ColSum As Double
    Dim Ws As Worksheet
    Dim Target As Range
    Dim R As Long
    If ActiveSheet Is Worksheets("GL") Then
        ColSum = SumByColor("F")
        If ColSum <> xlNone / 10000 + xlNone Then
            Set Ws = Worksheets("Bank Rec")
            With Ws
                Set Target = .Cells(.Rows.Count, "B").End(xlUp)
                R = Target.Row + 1
                .Cells(R, "B").Value = Target.Value + 1
                ' you can fill in all the cells here
                .Cells(R, "G").Value = ColSum
            End With
        End If
        MsgBox "Please select a cell with coloured fill" & vbCr & _
               "on the ""GL"" worksheet.", _
               vbExclamation, "Procedural requirement"
    End If
End Sub
Private Function SumByColor(ByVal Clm As String) As Double
    ' 13 Oct 2017
    ' return -4142.4142 if an uncoloured cell is selected
    ' the code first looks at the colorindex of the cell in
    ' column Clm in the row of the currently active cell.
    ' Then it totals all contiguous cells of same color in column Clm
    Dim Ws As Worksheet
    Dim SumRng As Range
    Dim SumClm As Long
    Dim ColIndex As Long        ' ColorIndex is a value of Long data type
    Dim Rstart As Long, Rend As Long
    SumClm = Columns(Clm).Column
    With ActiveCell
        Set Ws = .Worksheet
        Set SumRng = Ws.Cells(.Row, SumClm)
    End With
    With SumRng
        ColIndex = .Interior.ColorIndex
        If (ColIndex <> xlNone) Then
            Rstart = .Row
            If Rstart > 1 Then
                Do While Ws.Cells(Rstart - 1, SumClm).Interior.ColorIndex = ColIndex
                    If Rstart = 1 Then Exit Do
                    Rstart = Rstart - 1
            End If
            Rend = .Row
            Do While Ws.Cells(Rend + 1, SumClm).Interior.ColorIndex = ColIndex
                Rend = Rend + 1
            With Ws.Columns(SumClm)
                Set SumRng = Range(.Cells(Rstart), .Cells(Rend))
            End With
            SumByColor = Application.Sum(SumRng)
            SumByColor = xlNone / 10000 + xlNone
        End If
    End With
End Function

Note that the function 'SumByColor' must be called with a string (for example "F") to indicate the column to be summed. The function will return -4142.4142 if an uncoloured cell was selected which will prevent the result from being processed.

Observe that the function 'SumByColor' is private in scope, the sub 'WriteToBankRec' is public. You can call the public sub from the worksheet but the private function only from another procedure in Module1.



Thank you for support, I am new to Macros however i know how to run it, I added this to my file, Run it, but it only totals the yellow highligted cells of GL in Bank Rec' s Cell G7, I need the whole data of GL from B3 to F6 Copy pasted (mirror) in Bank Rec's sheet C7 to G11. Further whenever I enters new data in GL and colors it with (Light Golden), it should auto reflect on GL sheet below the existing rows. Once again thank you for the anwer and Hopefully you understood what i want to achive.
Idrees Oct 13, '17 at 11:00 am
I do understand now, I think, but disagree with your logic. You should either mirror all the data or mirror new additions. If you always mirror new additions there never will be any which aren't mirrored yet. And that thought leads to the question of how to identify the new additions, in fact, how to apply the fill (why not after creating the copy?). In theory it would be possible to check all entries in Bank Rec and avoid creating duplicates but that takes time and is error prone if someone decides to make a modification in either sheet. You might add a checkmark (set by the code) to mark entries already mirrored. Personally, I hate keeping copies. I would prepare the Bank Rec when I need it and not before.
Variatus (rep: 4108) Oct 13, '17 at 10:16 pm
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login