CODEWITHSUNDEEP
excelvba
Jeremy F
Jeremy F

Reputation: 1

VBA code in excel operates inconsistently with very simple code

I wrote some pretty simple VBA (excel macros) code to manage my audio licencing excel experience. The code is supposed to look through the excel sheet in column 3, look for any that have "AMC" in their column, and then copy and paste the row to sheet 2 and continue searching through entire excel document. This code is very simple and worked once right before it stopped working right. It only takes the very last AMC value and puts that on sheet 2 but not the other 5 rows that have AMC in their column 3 value.

Please help! I would appreciate it very much :)

-Jeremy

VBA Code:

Sub CommandButton1_Click()

    a = Worksheets("Sheet1").UsedRange.Rows.Count

    b = 0

    For i = 2 To a

        If Worksheets("Sheet1").Cells(i, 3).Value = "AMC" Then

            Worksheets("Sheet1").Rows(i).Copy

            Worksheets("Sheet2").Activate

           ' b = ActiveSheet.UsedRange.Rows.Count

            Worksheets("Sheet2").Cells(b + 1, 1).Select

            ActiveSheet.Paste

            Worksheets("Sheet1").Activate

        End If

    Next

    Application.CutCopyMode = False

    ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Select

End Sub

Upvotes: 0

Views: 55

Answers (2)

QHarr
QHarr

Reputation: 84465

You could use Instr and Union.

  1. Union is very efficient as you store all the qualifying ranges in memory and then write out only once to the sheet. Much less expensive operation than continually writing out to the sheet.
  2. Instr allows you to use vbBinaryCompare which means you are doing a case sensitive match i.e. only AC not ac will be matched on.
  3. The code belows avoids .Activate, which is again an expensive operation that isn't required.
  4. UsedRange means you may be looping many more rows than required. You only want to loop to the last populated row in column C of sheet 1, as that is the column you are testing. Hence, I use .Cells(.Rows.Count, C").End(xlUp).Row to find that last row.
  5. Use Option Explicit - research why! It will make your VBA life soooooo much better.

Code:

Option Explicit    
Sub CommandButton1_Click()

    Dim lastRow As Long, sSht As Worksheet, tSht As Worksheet, loopRange As Range
    Set sSht = ThisWorkbook.Worksheets("Sheet1")
    Set tSht = ThisWorkbook.Worksheets("Sheet2")

    With sSht
        Set loopRange = .Range("C2:C" & .Cells(.Rows.Count, C").End(xlUp).Row)
    End With

    Dim rng As Range, unionRng As Range
    For Each rng In loopRange
        If InStr(1, rng.Value, "AC", vbBinaryCompare) > 0 Then
            If Not unionRng Is Nothing Then
                Set unionRng = Union(unionRng, rng)
            Else
                Set unionRng = rng
            End If
        End If
    Next rng
    If Not unionRng Is Nothing Then unionRng.EntireRow.Copy tSht.Cells(1, 1)    
End Sub

Upvotes: 1

eren
eren

Reputation: 810

This should solve your problem : 

  If Worksheets("Sheet1").Cells(i, 3).Value = "AMC" Then    
        Worksheets("Sheet1").Rows(i).Copy  
        Worksheets("Sheet2").Activate   
        Worksheets("Sheet2").Cells(b + 1, 1).Select    
        b = b + 1    
        ActiveSheet.Paste   
        Worksheets("Sheet1").Activate        
  End If

Upvotes: 1

Related Questions