Excel Forum

Code: Select all

Sub UpdateAll()
    UpdateData
    DeleteData
End Sub

Code: Select all

Option Base 1
Sub ShowEmp()
Dim a() As Variant, lng As Long
Dim r As Range, rAll As Range
Dim rt As Range, rl As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
rl = Rows.Count
With Worksheets("Data2")
    Set rAll = .Range("G2", .Range("G" & rl).End(xlUp))
End With
For Each r In rAll
    If r = Worksheets("Report").Range("E2") Then
        lng = lng + 1
        ReDim Preserve a(5, lng)
        a(1, lng) = lng
        a(2, lng) = r.Offset(0, -6)
        a(3, lng) = r.Offset(0, -5)
        a(4, lng) = r.Offset(0, -4)
        a(5, lng) = r.Offset(0, -3)
    End If
Next r
If lng > 0 Then
    With Worksheets("Report")
        Set rt = .Range("A5", .Range("E" & lng - 1 + 5))
        .Range("A5", .Range("E" & rl)).ClearContents
        .Range("A5:E5").Copy
        rt.PasteSpecial xlPasteFormats
        rt = Application.Transpose(a)
        .Range("E2").Select
    End With
Else
    MsgBox "Data not found."
End If
Application.EnableEvents = True
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Code: Select all

 ReDim Preserve a(5, lng)

Code: Select all

 ReDim Preserve a(9, lng)

Code: Select all

Set rt = .Range("A5", .Range("J" & lng - 1 + 5))

Code: Select all

Set rt = .Range("A5", .Range("J" & lng - 1 + 9))

Code: Select all

.Range("B5", .Range("B" & rl).End(xlUp)).NumberFormat = "@"

Code: Select all

Sub UpdateAll()
    UpdateData
    DeleteData
End Sub

Sub UpdateData()
Dim rsAll As Range, rtAll As Range
Dim rs As Range, i As Integer
With Worksheets("Report")
       Set rsAll = .Range("L5", .Range("L" & (5 - 1 + .Range("H2"))))
End With
With Worksheets("Database")
       Set rtAll = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
End With
For Each rs In rsAll
    For i = rtAll.Count To 1 Step -1
        If rs.Offset(0, -10) = rtAll(i).Offset(0, -1) _
            And rs.Offset(0, -9) = rtAll(i) _
            And rs = "Update" Then
                rs.Offset(0, -10).Resize(1, 10).Copy
                rtAll(i).Offset(0, -1).PasteSpecial xlPasteValues
        End If
    Next i
Next rs
Application.CutCopyMode = False
End Sub

Sub DeleteData()
Dim rsAll As Range, rtAll As Range
Dim rs As Range, i As Integer
With Worksheets("Report")
    Set rsAll = .Range("L5", .Range("L" & (5 - 1 + .Range("H2"))))
       MsgBox "Please Confirm Delete & Update Data OI "
End With
With Worksheets("Database")
    Set rtAll = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
End With
For Each rs In rsAll
    For i = rtAll.Count To 1 Step -1
        If rs.Offset(0, -10) = rtAll(i).Offset(0, -1) _
            And rs.Offset(0, -9) = rtAll(i) _
            And rs = "Update" Then
                rtAll(i).EntireRow.Delete
        End If
    Next i
Next rs
End Sub