Copy Value from yesterday

A

akaseto

New Member
Joined
Oct 10, 2021
Messages
18
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
hello, i want to copy value from yesterday everytime i opened the excel file if certain value < today
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
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
Sort by date Sort by votes
Glad to hear you got the solution.

If you would like to post and share the solution then it is perfectly fine to mark your post as the solution to help future readers. Otherwise, please do not mark a post that doesn't contain a solution.
 
Upvote 0
uhh im sorry, i dont know the rules, if this would help others so it was my mistake

new code :
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)

if Lap.Range("C4").Value < Tgl Then
'----------------------------------------------------------------
'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
                            .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 + 2 & ":" & LKrw).Delete
                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
                            .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 + 2 & ":" & LBrw).Delete
                        Else
                        End If
                End With
            Lap.Activate
        With Lap
            .Range("C4").Value = Tgl
        End With
End Sub

i use .UsedRange.Rows.Count to find unused row after adding yesterday value to the last row of data and delete them, changed form :
Rich (BB code): 
If LKrw > LastLK Then dtSir.Rows(LastLK + 1 & ":" & LKrw).Delete
If LBrw > LastLB Then dtLB.Rows(LastLB + 1 & ":" & LBrw).Delete
(which always delete my new added value) to :
Rich (BB code): 
If LKrw > LastLK Then dtSir.Rows(LastLK + 2 & ":" & LKrw).Delete
If LBrw > LastLB Then dtLB.Rows(LastLB + 2 & ":" & LBrw).Delete
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
331
RoryA
RoryA
I
  • Question
Move existing row of value to another selected row
Replies
1
Views
131
ipbr21054
I
S
  • Question
Need code that adds multiple new rows to table to include a check box in column "L" for each new row
Replies
0
Views
321
sspatriots
S
B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
1
Views
204
bobaol
B
J
  • Question
VBA Code to Add Rows is slowing down
Replies
5
Views
501
JayB0730
J

Forum statistics

Threads
1,214,832
Messages
6,121,849
Members
449,051
Latest member
excelquestion515

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top