Snasui Excel Forum

Code: Select all

Sub AddData()
    Dim rAll As Range, rs As Range
    Dim rt As Range
    With Sheets("Edit")
        Set rAll = .Range("K4", .Range("K" & Rows.Count).End(xlUp))
    End With
    For Each rs In rAll
        With Sheets("DataStore")
            Set rt = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End With
        If rs = "Add" Then
            rs.Offset(0, -10).Resize(1, 10).Copy
            rt.PasteSpecial xlPasteValues
        End If
    Next rs
    Application.CutCopyMode = False
End Sub

Code: Select all

Sub Update()
Dim rsAll As Range, rtAll As Range
Dim rs As Range, i As Integer

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
On Error Resume Next

With Worksheets("Edit")
    Set rsAll = .Range("B4", .Range("B" & Rows.Count).End(xlUp))
End With

With Worksheets("DataStore")
    Set rtAll = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
End With

For Each rs In rsAll
    For i = rtAll.Count To 1 Step -1
        If rs = rtAll(i) And rs.Offset(0, 8) = rtAll(i).Offset(0, 8) _
        And rs.Offset(0, 9) = "Update" Then
            rs.Offset(0, -1).Resize(1, 10).Copy
            rtAll(i).Offset(0, -1).PasteSpecial xlPasteValues
        End If
    Next i
Next rs

Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Code: Select all

Sub Button2_Click()
Dim rFind As Range, rDataAll As Range
Dim r As Range, rTarget As Range
Set rFind = Sheets("Edit").Range("D2")
If Sheets("Edit").Range("D2") = "" Then Exit Sub
With Sheets("DataStore")
    Set rDataAll = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
    If .Columns("b:b").Find(rFind, LookIn:=xlValues) Is Nothing Then
        MsgBox ("äÁèÁÕàÅ¢ PO ¹Õé")
        Exit Sub
    End If
End With
For Each r In rDataAll
    If r = rFind Then
        Set rTarget = Sheets("Edit").Range("B" & Rows.Count).End(xlUp) _
            .Offset(1, 0)
        r.Resize(1, 9).Copy
        rTarget.PasteSpecial xlPasteValues
        rTarget.Offset(0, -1) = Date
    End If
Next r
Application.CutCopyMode = False
MsgBox "Get data has finished."
End Sub

Code: Select all

Sub ShowData()
   'Other code
        .Range(.Range("B3").End(xlDown).Offset(1, 0), .Range("I" & rl)).Clear
   'Other code
End Sub

Code: Select all

Sub ShowData()
   'Other code
        .Range(.Range("B3").End(xlDown).Offset(1, 0), .Range("I" & rl)).ClearContents
        .Range(.Range("B3").End(xlDown).Offset(1, 0), .Range("I" & rl)).ClearFormats
   'Other code
End Sub

Code: Select all

Sub Update()
Dim rsAll As Range, rtAll As Range
Dim rs As Range, i As Integer

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
On Error Resume Next

With Worksheets("Edit")
    Set rsAll = .Range("B4", .Range("B" & Rows.Count).End(xlUp))
End With

With Worksheets("DataStore")
    Set rtAll = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
End With

For Each rs In rsAll
    For i = rtAll.Count To 1 Step -1    
        If rs = rtAll(i) And rs.Offset(0, 8) = rtAll(i).Offset(0, 8) _
        And rs.Offset(0, 9) = "Update" Then
            rs.Offset(0, -1).Resize(1, 10).Copy
            rtAll(i).Offset(0, -1).PasteSpecial xlPasteValues
        End If
    Next i
Next rs

Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub