Help with a date function

[Davealot]

Greetings, I'm using the following code:

Option Explicit


Sub beepbeepbeep()
'
' beepbeepbeep Macro
'

'
    Range("A:A,C:C,D:D,E:E,G:G,H:H,I:I,K:K").Select
    Range("K1").Activate
    Selection.Delete Shift:=xlToLeft
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("D:D").Select
    Selection.Cut Destination:=Columns("A:A")
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
 
    Dim CurrRow As Integer

Range("A2").Select
Do Until IsEmpty(ActiveCell)
    If ActiveCell = IsDate + 1 Then
        CurrRow = ActiveCell.Row
        Range("A" & CurrRow & ":D" & CurrRow).Copy
        Range("G" & Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Range("A" & CurrRow & ":D" & CurrRow).Select
        Selection.Delete Shift:=xlUp
        Range("A" & CurrRow).Select
    Else
        ActiveCell.Offset(1, 0).Select
    End If
Loop

    Range("A:A,B:B,C:C,D:D,E:E,F:F").Select
    Selection.Delete Shift:=xlToLeft
 

Range("A1").Select
 
 
 
End Sub

The problem, as I'm sure you can see but I cannot is that it's not checking cell A2, looking for a date and adding one day to it, and cutting out the information that I need. I've attached spreadsheet that I'm working on as well. I just need it to cut out tomorrow's information. Any help would be greatly appreciated thanks ladies/gents.

 

[Davealot]

Also on a seperate note, is there any way that you can run a macro to see what will happen, but that will allow you to undo? I'm trying to crash through this VBA coding, but I keep coming up on mistakes when I run a macro and I have to start all over with a new spreadsheet when a mistake comes up, thanks.

 

[Chihiro]

Undo operation after VBA isn't easy. Refer to the thread below.
http://chandoo.org/forum/threads/macro-to-format-row-based-on-cell-value.29174/#post-174369

Generally speaking. You don't want to modify existing sheet/data permanently during test (or even at final stage of development).

I'd usually output result to new sheet/region. Depending on the operation required, it's pretty easy to make copy of original to do operation and delete copy once done.

For your workbook. You can do something like below ("Export" sheet added).

Sub Test()
Dim lRow As Long
Dim delRange As Range
Dim sourceWs As Worksheet, destWs As Worksheet, tempWs As Worksheet


Set sourceWs = Worksheets("Data")
Set destWs = Worksheets("Export")
'add temp worksheet
Set tempWs = Worksheets.Add
'Turn off screen update and alert popups during process
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Copy Data sheet to temp sheet
sourceWs.Cells.Copy tempWs.Cells(1, 1)

With tempWs
    lRow = .Cells(Rows.Count, 1).End(xlUp).Row
'Create union of non contiguous range and delete all at once
    Set delRange = Union(.Range("A1:A" & lRow), .Range("K1:K" & lRow), .Range("C1:E" & lRow), .Range("G1:I" & lRow))
    delRange.Delete Shift:=xlToLeft
'Move Date column from C to A column
    .Range("C1").EntireColumn.Cut
    .Range("A1").EntireColumn.Insert Shift:=xlRight
'Filter the data for those dates matching today + 1 day
    .Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=Date + 1
'Copy visible range and paste to Export sheet
    .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy destWs.Cells(1, 1)
End With
'Delete temp sheet
tempWs.Delete
'Turn on screen update and alert
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[NARAYANK991]

Hi ,

To address your issue with code errors , see if this helps.

http://excelmacromastery.com/Blog/index.php/how-to-dramatically-reduce-your-vba-errors/

Narayan

 

[Davealot]

Chihiro, Thank you very much for the reply, I will begin testing once we receive orders today. I am much obliged for your assistanace. Narayank Thank you for the link I will certainly spend time reading, as I'm positive there is a better way to do these things, I just can't think them through yet! Thank you kindly!