CODEWITHSUNDEEP
excelvba
Gary Tang
Gary Tang

Reputation: 15

How to do multiple select with ActiveCell

I'm trying to make multiple selections from Sheet2. The value is from the same column but different rows (thinking if using ActiveCell.Offset(1,0) will be feasible).

My code takes the value from an ActiveCell select and runs a macro compares it to another sheet (Sheet10) with some information to copy and paste in a target sheet (Sheet5).

The following is the code that I have right now.

a = Sheet10.Cells(Rows.Count, 1).End(xlUp).Row
c = Sheet2.Cells(Rows.Count, 5).End(xlUp).Row

For Each cell In Range(ActiveCell, ActiveCell.Offset(1, 0))

For i = 2 To a 'from Row 1 to the last row of "DMP"
Debug.Print ("i = " & i)

If cell.Value = Sheet10.Cells(i, 1).Value Then 'if selected cell matches (i,1) of "Sheet10 (DMP)"
    Debug.Print ("ActiveCell =" & ActiveCell.Value)

    For k = 1 To 20 'from Column 1 to Column 20
        Debug.Print ("k = " & k)

        For r = 1 To c 'from Row 1 to the last row of "Sheet 2(LightOn SKU)"
            Debug.Print ("r = " & r)

            If Sheet10.Cells(i, k).Value = Sheet2.Cells(r, 4).Value Then 'if value of (i,k) of "Sheet10 (DMP)" = (r,4) of "Sheet2 (LightOn SKU)"

                Sheet2.Range("A" & r & ":G" & r).Copy
                Sheet5.Activate
                b = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row
                Sheet5.Cells(b + 1, 1).Select
                ActiveSheet.Paste
                Range("A" & r & ":L" & r).Borders.Color = vbBlack
             End If

        Next

    Next

End If

Next

Next

Right now, it's running on an endless loop.

Upvotes: 0

Views: 679

Answers (1)

VBasic2008
VBasic2008

Reputation: 54817

Still Unclear

Sub ACCopy2()

  Dim a As Long
  Dim c As Long
  Dim r As Long
  Dim i As Long
  Dim k As Integer
  Dim b As Long

  a = Sheet10.Cells(Rows.Count, 1).End(xlUp).Row
  c = Sheet2.Cells(Rows.Count, 5).End(xlUp).Row

  For r = 1 To c ' from Row 1 to the last row of "Sheet 2(LightOn SKU)"
    Debug.Print ("r = " & r)
    For i = 2 To a ' from Row 1 to the last row of "DMP"
      Debug.Print ("i = " & i)
      ' if selected cell matches (i,1) of "Sheet10 (DMP)"
      If Sheet2.Cells(r, 1).Value = Sheet10.Cells(i, 1).Value Then
        Debug.Print ("Sheet2 =" & Sheet2.Cells(r, 1).Value)
        For k = 1 To 20 ' from Column 1 to Column 20
          Debug.Print ("k = " & k)

          ' if value of (i,k) of "Sheet10 (DMP)" = (r,4) of
          ' "Sheet2 (LightOn SKU)"
          If Sheet10.Cells(i, k).Value = Sheet2.Cells(r, 4).Value Then
            With Sheet5
              b = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row
              Sheet2.Range("A" & r & ":G" & r).Copy .Cells(b + 1, 1)
              .Range("A" & r & ":L" & r).Borders.Color = vbBlack
            End With
          End If

        Next
      End If
    Next
  Next

End Sub

Upvotes: 1

Related Questions