Excel Forum

Code: Select all

'Other code
Application.Calculation = xlCalculationManual
Range("E9:F33").ClearContents
For i = 2 To 5000
    If Sheets("database").Range("A" & i).Value = Sheets("baibake").Range("M8") Then
        Sheets("database").Range("D" & i).Copy
        Sheets("baibake").Range("E" & Rows.Count).End(xlUp).Offset(1, 0) _
        .PasteSpecial xlPasteValues
        Sheets("database").Range("G" & i).Copy
        Sheets("baibake").Range("F" & Rows.Count).End(xlUp).Offset(1, 0) _
        .PasteSpecial xlPasteValues
    End If
Next i
Range("M2").Select
Application.Calculation = xlCalculationAutomatic
'Other code

Code: Select all

Sub Duplicate()
Dim lngLastRow As Long, lngLoopRow As Long
Dim lngWriteRow As Long
Dim rngFindRange
lngWriteRow = 2
lngLastRow = Cells(Rows.Count, 2).End(xlUp).Row

Range("D2:D" & lngLastRow).ClearContents
For lngLoopRow = lngLastRow To 2 Step -1
    With Cells(lngLoopRow, 2)
        If Application.WorksheetFunction.CountIf(Range("B2:B" & lngLastRow), .Value) > 1 Then
            If Range("D:D").Find(.Value, lookat:=xlWhole) Is Nothing Then
                Cells(lngWriteRow, 4) = .Value
                lngWriteRow = lngWriteRow + 1
            End If
        End If
    End With
Next lngLoopRow
End Sub

Code: Select all

Sub Test0()
    With Sheets("Sheet2")
        .Range("b:b").Value = Sheets("Sheet1").Range("b:b").Value
        With .Range("b2").CurrentRegion
            .RemoveDuplicates Columns:=1, Header:=xlNo
        End With
    End With
End Sub

Code: Select all

'Other code
With .Range("B2", .Range("b" & .Rows.Count).End(xlUp))
    .RemoveDuplicates Columns:=1, Header:=xlNo
End With
'Other code

Code: Select all

Sub AStock()
    With Sheets("Database")
        .Columns("p").Clear
        .Range("q:q").NumberFormat = "@"
        .Range("Q:Q").Value = .Range("A:A").Value
        With .Range("Q2", .Range("Q" & .Rows.Count).End(xlUp))
            .RemoveDuplicates Columns:=1, Header:=xlNo
        End With
        If .Range("q2").Value <> "" Then
            With .Range("q2").CurrentRegion.Offset(0, -1)
                .Formula = "=Rows(r2c:rc)"
                .Value = .Value
            End With
        End If
    End With
End Sub