[Solved] Excel VBA – Cut and Paste cell to new cell location based on row/ column condition

by


I believe the following should do what you are expecting, I’ve added a loop to go from row 3 on column F to the last row in case you add more shapes and colors there, so it will add all of them if found into the table:

Sub foo()
Dim FindShape As Range, FindColor As Range
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
'get the last row with data on Column A

    For i = 3 To LastRow
    vAmount = ws.Cells(i, "F").Value 'get the amount into a variable
    vShape = ws.Cells(i, "G").Value 'get the shape
    vColor = ws.Cells(i, "H").Value 'get the color

        Set FindShape = ws.Range("A:A").Find(What:=vShape, LookAt:=xlWhole) 'find shape on column A
        Set FindColor = ws.Rows(1).Find(What:=vColor, LookAt:=xlWhole) 'find color on Row 1

        If Not FindShape Is Nothing And Not FindColor Is Nothing Then 'if shape and color found then add amount to that cell
            ws.Cells(FindShape.Row, FindColor.Column).Value = vAmount
        End If
    Next i
End Sub

UPDATE:

In case of duplicate entries, such as multiple Blue Circles with different amount, the following will add the values into your table:

   Sub foo()
    Dim FindShape As Range, FindColor As Range
    Dim ws As Worksheet: Set ws = Sheets("Sheet1")
    'declare and set your worksheet, amend as required
    LastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
    'get the last row with data on Column A

        For i = 3 To LastRow
        vAmount = Val(ws.Cells(i, "F").Value) 'get the amount into a variable
        vShape = ws.Cells(i, "G").Value 'get the shape
        vColor = ws.Cells(i, "H").Value 'get the color

            Set FindShape = ws.Range("A:A").Find(What:=vShape, LookAt:=xlWhole) 'find shape on column A
            Set FindColor = ws.Rows(1).Find(What:=vColor, LookAt:=xlWhole) 'find color on Row 1

            If Not FindShape Is Nothing And Not FindColor Is Nothing Then 'if shape and color found then add amount to that cell
                ws.Cells(FindShape.Row, FindColor.Column).Value = Val(ws.Cells(FindShape.Row, FindColor.Column).Value) + vAmount
            End If
        Next i
    End Sub

3

solved Excel VBA – Cut and Paste cell to new cell location based on row/ column condition