hello, i want to copy value from yesterday everytime i opened the excel file if certain value < today
with dtSir its works perfect but with dtLB it wont add value, i need to run macro twice but the value are not actual.
please take a look this excel file : my example
VBA Code:
Private Sub LB_BESOK()
Application.ScreenUpdating = False
Dim Lap, dtLB, dtSir As Worksheet
Dim Tgl As Date
Dim LastLK,LastLB, LBrw, LKrw As Long
Dim Bln As String
Set Lap = ThisWorkbook.Worksheets("Laporan Kas")
Set dtLB = ThisWorkbook.Worksheets("Kas LB")
Set dtSir = ThisWorkbook.Worksheets("Kas Kasir")
Tgl = Format((Date), "dd/mm/yyyy")
Bln = MonthName(Month(Date), False)
'----------------------------------------------------------------
'MENENTUKAN VALUE
'----------------------------------------------------------------
'FOR LC-----------------
Lk100k = Lap.Cells(23, 10).Value
Lk50k = Lap.Cells(24, 10).Value
Lk20k = Lap.Cells(25, 10).Value
Lk10k = Lap.Cells(26, 10).Value
Lk5k = Lap.Cells(27, 10).Value
Lk2k = Lap.Cells(28, 10).Value
Lk1k = Lap.Cells(29, 10).Value
Lk200 = Lap.Cells(30, 10).Value
Lk100 = Lap.Cells(31, 10).Value
jml_Lk = Lap.Cells(32, 10).Value
jml_lap = Lap.Cells(20, 6).Value
slsh = Lap.Cells(23, 6).Value
'----------------------------------------------------------------
'DTSIR
'----------------------------------------------------------------
'LC-------------------------------------------
With dtSir
LKrw = dtSir.UsedRange.Rows.Count
LastLK = .Cells(Rows.Count, "A").End(xlUp).Row
If .Cells(LastLK, 1).Value < Tgl Then
.Cells(LastLK + 1, 1).Value = Tgl
.Cells(LastLK + 1, 2).Value = Bln
.Cells(LastLK + 1, 3).Value = Lk100k
.Cells(LastLK + 1, 4).Value = Lk50k
.Cells(LastLK + 1, 5).Value = Lk20k
.Cells(LastLK + 1, 6).Value = Lk10k
.Cells(LastLK + 1, 7).Value = Lk5k
.Cells(LastLK + 1, 8).Value = Lk2k
.Cells(LastLK + 1, 9).Value = Lk1k
.Cells(LastLK + 1, 10).Value = Lk200
.Cells(LastLK + 1, 11).Value = Lk100
.Cells(LastLK + 1, 12).Value = jml_Lk
.Cells(LastLK + 1, 13).Value = jml_lap
If slsh > 0 Then
With dtSir
.Cells(LastLK + 1, 14).Value = slsh
End With
ElseIf slsh < 0 Then
With dtSir
.Cells(LastLK + 1, 15).Value = slsh
End With
Else
End If
With .Range("A" & LastLK + 1, "O" & LastLK + 1)
.Interior.Color = RGB(230, 200, 255)
.Columns.AutoFit
.BorderAround xlContinuous
.Rows.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Rows.Borders(xlInsideVertical).LineStyle = xlContinuous
End With
If LKrw > LastLK Then dtSir.Rows(LastLK + 1 & ":" & LKrw).Delete
Else
End If
End With
'----------------------------------------------------------------
'FOR DTLB
'----------------------------------------------------------------
' LB----------------------------------------------
Lb100k = Lap.Cells(9, 12).Value
Lb50k = Lap.Cells(10, 12).Value
Lb20k = Lap.Cells(11, 12).Value
Lb10k = Lap.Cells(12, 12).Value
Lb5k = Lap.Cells(13, 12).Value
Lb2k = Lap.Cells(14, 12).Value
Lb1k = Lap.Cells(15, 12).Value
Lb200 = Lap.Cells(16, 12).Value
Lb100 = Lap.Cells(17, 12).Value
jml_Lb = Lap.Cells(18, 12).Value
'----------------------------------------------------------------
'DTLB
'----------------------------------------------------------------
' LB----------------------------------------------
With dtLB
LBrw = dtLB.UsedRange.Rows.Count
LastLB = .Cells(Rows.Count, "A").End(xlUp).Row
If .Cells(LastLB, 1).Value < Tgl Then
.Cells(LastLB + 1, 1).Value = Tgl
.Cells(LastLB + 1, 2).Value = Bln
.Cells(LastLB + 1, 3).Value = Lb100k
.Cells(LastLB + 1, 4).Value = Lb50k
.Cells(LastLB + 1, 5).Value = Lb20k
.Cells(LastLB + 1, 6).Value = Lb10k
.Cells(LastLB + 1, 7).Value = Lb5k
.Cells(LastLB + 1, 8).Value = Lb2k
.Cells(LastLB + 1, 9).Value = Lb1k
.Cells(LastLB + 1, 10).Value = Lb200
.Cells(LastLB + 1, 11).Value = Lb100
.Cells(LastLB + 1, 12).Value = "SISA KEMARIN"
.Cells(LastLB + 1, 13).Value = jml_Lb
With .Range("A" & LastLB + 1, "M" & LastLB + 1)
.Interior.Color = RGB(230, 200, 255)
.Columns.AutoFit
.BorderAround xlContinuous
.Rows.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Rows.Borders(xlInsideVertical).LineStyle = xlContinuous
End With
If LBrw > LastLB Then dtLB.Rows(LastLB + 1 & ":" & LBrw).Delete
Else
End If
End With
Lap.Activate
With Lap
Range("C4").Value = Tgl
End With
End Sub
with dtSir its works perfect but with dtLB it wont add value, i need to run macro twice but the value are not actual.
please take a look this excel file : my example