Posts by nilem

Sub ertert()
Dim x, i As Long, j As Long, k As Long, bu As Boolean
With Range("A1").CurrentRegion
    x = .Resize(.Rows.Count + 1).Value
    For i = 1 To UBound(x, 1) - 1
        k = k + 1
        For j = 1 To UBound(x, 2)
            x(k, j) = x(i, j)
        Next j
        Do While x(i, 5) = "C"
            i = i + 1: bu = True
        Loop
        If bu Then
            x(k, 3) = x(i - 1, 3): x(k, 4) = x(i - 1, 4)
            x(k, 7) = x(i - 1, 7): bu = Not bu: i = i - 1
        End If
    Next i
    .ClearContents: .Resize(k).Value = x
End With
End Sub

Sub copycellsover()
Dim strFirstFile$, strSecondFile$, strThirdFile$
Dim wbk As Workbook
strFirstFile = "I:\A.xls": strSecondFile = "I:\B.xls": strThirdFile = "I:\C.xls"
Set wbk = Workbooks.Open(strSecondFile)    '"B.xls"
With Workbooks.Open(strFirstFile)
    .Sheets("Report Tracking List").Range("A3:A65536").Copy wbk.Sheets("Sheet1").Range("A2")
    .Close 0
End With
With Workbooks.Open(strThirdFile)
    .Sheets("sheet1").Range("E8:E65536").Copy wbk.Sheets("Sheet1").Range("B2")
    .Close 0
End With
'....................
End Sub

Sub copycellsover2()
Dim FirstArr, SecondArr
With GetObject("I:\A.xls")
    With .Sheets("Report Tracking List")
        FirstArr = .Range("A3", .Cells(Rows.Count, 1).End(xlUp)).Value
    End With
    .Close 0
End With
With GetObject("I:\C.xls")
    With .Sheets("sheet1")
        SecondArr = .Range("E8", .Cells(Rows.Count, 5).End(xlUp)).Value
    End With
    .Close 0
End With
'and here we compare FirstArr and  SecondArr for differences
End Sub

Private Sub CommandButton1_Click()
If Me.TextBox1.Value = vbNullString Then Exit Sub
Dim s$, t$
With Sheets("Data").Range("Names")
    s = Join(WorksheetFunction.Transpose(.Value), "|")
    t = Me.TextBox1.Value
    If InStr(s, "|" & t) Then
        MsgBox "The Name Already Exists", 64
    Else
        ThisWorkbook.Names("Names").RefersTo = .Resize(.Count + 1)
        .Cells(.Count + 1).Value = t
    End If
End With
End Sub

Sub ertert()
Dim x, i As Long, j As Long, k As Long, bu As Boolean
With Range("A1:G" & Cells(Rows.Count, 1).End(xlUp).Row + 1)
    x = .Value
    For i = 1 To UBound(x, 1) - 1
        k = k + 1
        For j = 1 To UBound(x, 2)
            x(k, j) = x(i, j)
        Next j
        Do While x(i, 5) = "C"
            i = i + 1: bu = True
        Loop
        If bu Then
            x(k, 3) = x(i - 1, 3): x(k, 4) = x(i - 1, 4)
            x(k, 7) = x(i - 1, 7): bu = Not bu: i = i - 1
        End If
    Next i
    .ClearContents: .Resize(k).Value = x
End With
End Sub

Sub ertert()
Dim x, y(), i&, j&, k&
x = Range("A1:B" & Cells(Rows.Count, 1).End(xlUp).Row).Value
ReDim y(1 To UBound(x) / 6, 1 To 7)
For i = 1 To UBound(x) Step 6
    k = k + 1
    For j = 1 To 6
        y(k, j) = x(i + j - 1, 1)
    Next j
    y(k, 7) = x(i, 2)
Next i
Range("E1:K1").Resize(k).Value = y()
End Sub