Snasui Excel Forum

Code: Select all

i = 1
Do While Cells(i, "C") <> ""
    If Cells(i, "C") = Cells(i + 1, "C") Then
        Cells(i, "C").EntireRow.Delete
    Else
        i = i + 1
    End If
Loop

Code: Select all

    i = 1
    For i = 1 To Range("C" & Rows.Count).End(xlUp).Row
        If Application.CountIf(Range("C1:C" & i), Cells(i, "C")) > 1 Then
            Cells(i, "C").Clear
        End If
    Next i
    If Application.CountIf(Range("C:C"), "") > 0 Then
        Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End If

Code: Select all

Dim i As Integer
    i = 1
    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    Selection.Copy.Range("A" & i).Value
    Workbooks.Open Filename:= _
        "C:\Documents and Settings\T02083\My Documents\ref.xls"
    Windows("ref.xls").Activate
     If Workbooks("test yes0 t1.xls").Range("A" & i).Value = Range("A" & i).Value Then
     Selection.Copy.Range("B" & i).Value
     Windows("test yes0 t1.xls").Activate
     Range("D" & i).Select
    ActiveSheet.Paste
    Else
    ActiveCell.FormulaRiCi = "no data"
    Rows("i:i").Select
    Selection.Font.ColorIndex = 3
    End If
    Next i
End Sub

Code: Select all

Dim wb1, wb2 As Workbook

Application.ScreenUpdating = False
Set wb1 = ActiveWorkbook
LastRow1 = wb1.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
Set wb2 = Workbooks.Open("C:\Documents and Settings\My Documents\ref.xls", False, False)
LastRow2 = wb2.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To LastRow1
    For j = 1 To LastRow2
        If wb2.Sheets(1).Range("A" & j).Value = wb1.Sheets(1).Range("A" & i).Value Then
           wb1.Sheets(1).Range("D" & i).Value = wb2.Sheets(1).Range("B" & j).Value
           f = 1
        End If
    Next j
   If f = 0 Then
        wb1.Sheets(1).Range("D" & i).Value = "no data"
        wb1.Sheets(1).Range("D" & i).Font.ColorIndex = 3  
   End If
   f = 0
Next i

wb2.Close False
Application.ScreenUpdating = True