excel if statement + date

K

kelvin_9

Active Member
Joined
Mar 6, 2015
Messages
460
Office Version
  1. 2019
Hi All,

i'm very new to VBA, i need some help here and this is my code

my question is, i enter a date in A2 at sheet3 and run the first macro, the first result is prefect and exactly what i want
however, i get A1 filled as well when i run the second macro with a new date at the second times
what's wrong with my code and how could i fix?

VBA Code: 
Sub Macro1()
'
' NORMAL STORE
'

'
    'filter store and location
    Sheets("Sheet1").Select
    Rows("1:1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$V$1").AutoFilter Field:=2, Criteria1:="NORMAL"
    ActiveSheet.Range("$A$1:$V$1").AutoFilter Field:=9, Criteria1:="<>"
    Cells.Select
    Selection.Copy
    Sheets("Sheet2").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("A1").Select
    Selection.AutoFilter

    'copy order id
    Sheets("Sheet2").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Sheet3").Select
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'fill date, code, company name
    Sheets("Sheet3").Select
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]+2"
    Selection.AutoFill Destination:=Range("B2:B" & Range("F" & Rows.Count).End(xlUp).Row)
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "1234567"
    Selection.AutoFill Destination:=Range("D2:D" & Range("F" & Rows.Count).End(xlUp).Row)
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "ABC"
    Selection.AutoFill Destination:=Range("E2:E" & Range("F" & Rows.Count).End(xlUp).Row)
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(Sheet2!RC[12],"" "",Sheet2!RC[11])"
    Selection.AutoFill Destination:=Range("G2:G" & Range("F" & Rows.Count).End(xlUp).Row)

    'fill address
    Sheets("Sheet2").Select
    Range("U2:V1000").Select
    Selection.Copy
    Sheets("Sheet3").Select
    Range("H2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'fill phone
    Sheets("Sheet2").Select
    Range("T2:T1000").Select
    Selection.Copy
    Sheets("Sheet3").Select
    Range("L2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet2").Select
    Range("H2:H1000").Select
    Selection.Copy
    Sheets("Sheet3").Select
    Range("M2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'fill box, quantity, weight
    Sheets("Sheet3").Select
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "box"
    Selection.AutoFill Destination:=Range("Q2:Q" & Range("F" & Rows.Count).End(xlUp).Row)
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "1"
    Selection.AutoFill Destination:=Range("R2:R" & Range("F" & Rows.Count).End(xlUp).Row)
    Range("S2").Select
    ActiveCell.FormulaR1C1 = "3"
    Selection.AutoFill Destination:=Range("S2:S" & Range("F" & Rows.Count).End(xlUp).Row)
    Range("S3").Select

    'fill date
    Sheets("Sheet3").Select
    Dim Lr As Long
    Lr = Range("A" & Rows.Count).End(xlUp).Row
    Range("A" & Lr, Range("B" & Rows.Count).End(xlUp).Offset(, -1)).FillDown

    'value
    Sheets("Sheet3").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False

    'clear data in sheet2 if any
    Sheets("Sheet2").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 0
    End With
    Range("A1").Select
    Sheets("Sheet1").Select
    Selection.AutoFilter
    Range("A1").Select

    'delete object and move
    Sheets("Sheet3").Select
    ActiveSheet.DrawingObjects.Select
    Selection.Delete
    ActiveSheet.Copy
    Sheets("Sheet3").Name = "normal store"

    'clear data in sheet3 if any
    Windows("store.xlsm").Activate
    Sheets("Sheet3").Select
    Rows("2:1000").Select
    Selection.Delete
    Range("A2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.499984740745262
        .PatternTintAndShade = 0
    End With

End Sub

Book1
AB
1Ship out dateConsignee's_Request Date
201 April, 202203 April, 2022
301 April, 202203 April, 2022
normal store


Book1
AB
120 April, 2022Consignee's_Request Date
220 April, 202222 April, 2022
320 April, 202222 April, 2022
limited store


thank you very much
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
I believe it is towards the bottom. Attempted to duplicate , but without all the worksheets and data it is difficult.

Look at where your comment is " 'delete object and move"

If no object selected. Then cell A1 remains selected from the line above the comment, then gets deleted. Which results in the cells shifting the data up , removing your header.
 
Upvote 0
Here is a "Cleaned up" version of your code.
Since you are new to VBA I though you would benefit from looking at the comparison. There are still better ways than my changes.

The main take away I wanted to share is that you do not have to SELECT an cell or object to work with it.

If you have time, try this in a copy of your original to be safe.

VBA Code: 
Option Explicit

Sub Macro1()
'NORMAL STORE
'VARIABLES
Dim WS_1 As Worksheet
    Set WS_1 = Sheets("Sheet1")
Dim WS_2 As Worksheet
    Set WS_2 = Sheets("Sheet2")
Dim WS_3 As Worksheet
    Set WS_3 = Sheets("Sheet3")
Dim Lr As Long
    'filter store and location
    WS_1.Activate
    WS_1.Rows("1:1").AutoFilter
    WS_1.Range("$A$1:$V$1").AutoFilter Field:=2, Criteria1:="NORMAL"
    WS_1.Range("$A$1:$V$1").AutoFilter Field:=9, Criteria1:="<>"
    Cells.Copy
    WS_2.Activate
    WS_2.Paste
    'back to worksheet 1
    WS_1.Activate
    WS_1.Range("A1").AutoFilter
    'copy order id
    WS_2.Activate
    WS_2.Range("A2", Range("A2").End(xlDown)).Copy
    WS_3.Activate
    WS_3.Range("F2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'fill date, code, company name
    WS_3.Range("B2").FormulaR1C1 = "=RC[-1]+2"
    WS_3.Range("B2").AutoFill Destination:=Range("B2:B" & Range("F" & Rows.Count).End(xlUp).Row)
    WS_3.Range("D2").FormulaR1C1 = "1234567"
    WS_3.Range("D2").AutoFill Destination:=Range("D2:D" & Range("F" & Rows.Count).End(xlUp).Row)
    WS_3.Range("E2").FormulaR1C1 = "ABC"
    WS_3.Range("E2").AutoFill Destination:=Range("E2:E" & Range("F" & Rows.Count).End(xlUp).Row)
    WS_3.Range("G2").FormulaR1C1 = "=CONCATENATE(Sheet2!RC[12],"" "",Sheet2!RC[11])"
    WS_3.Range("G2").AutoFill Destination:=Range("G2:G" & Range("F" & Rows.Count).End(xlUp).Row)
    'fill address
    WS_2.Activate
    WS_2.Range("U2:V1000").Copy
    WS_3.Activate
    WS_3.Range("H2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'fill phone
    WS_2.Activate
    WS_2.Range("T2:T1000").Copy
    WS_3.Activate
    WS_3.Range("L2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    WS_2.Activate
    WS_2.Range("H2:H1000").Copy
    WS_3.Activate
    WS_3.Range("M2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'fill box, quantity, weight
    WS_3.Activate
    WS_3.Range("Q2").FormulaR1C1 = "box"
    WS_3.Range("Q2").AutoFill Destination:=Range("Q2:Q" & Range("F" & Rows.Count).End(xlUp).Row)
    WS_3.Range("R2").FormulaR1C1 = "1"
    WS_3.Range("R2").AutoFill Destination:=Range("R2:R" & Range("F" & Rows.Count).End(xlUp).Row)
    WS_3.Range("S2").FormulaR1C1 = "3"
    WS_3.Range("S2").AutoFill Destination:=Range("S2:S" & Range("F" & Rows.Count).End(xlUp).Row)
    'fill date
    Lr = WS_3.Range("A" & Rows.Count).End(xlUp).Row
    WS_3.Range("A" & Lr, WS_3.Range("B" & Rows.Count).End(xlUp).Offset(, -1)).FillDown
    'value
    WS_3.Cells.Copy
    WS_3.Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    'clear data in sheet2 if any
    WS_2.Activate
    WS_2.Cells.Delete Shift:=xlUp
    WS_1.Range("A1").AutoFilter
    'delete object and move
    WS_3.Activate
    WS_3.DrawingObjects.Delete
    WS_3.Copy
    WS_3.Name = "normal store"
    'clear data in sheet3 if any
    WS_3.Rows("2:1000").Delete
    With WS_3.Range("A2").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.499984740745262
        .PatternTintAndShade = 0
    End With

End Sub
 
Upvote 0
bstory84 said:
Here is a "Cleaned up" version of your code.
Since you are new to VBA I though you would benefit from looking at the comparison. There are still better ways than my changes.

The main take away I wanted to share is that you do not have to SELECT an cell or object to work with it.

If you have time, try this in a copy of your original to be safe.

VBA Code: 
Option Explicit

Sub Macro1()
'NORMAL STORE
'VARIABLES
Dim WS_1 As Worksheet
    Set WS_1 = Sheets("Sheet1")
Dim WS_2 As Worksheet
    Set WS_2 = Sheets("Sheet2")
Dim WS_3 As Worksheet
    Set WS_3 = Sheets("Sheet3")
Dim Lr As Long
    'filter store and location
    WS_1.Activate
    WS_1.Rows("1:1").AutoFilter
    WS_1.Range("$A$1:$V$1").AutoFilter Field:=2, Criteria1:="NORMAL"
    WS_1.Range("$A$1:$V$1").AutoFilter Field:=9, Criteria1:="<>"
    Cells.Copy
    WS_2.Activate
    WS_2.Paste
    'back to worksheet 1
    WS_1.Activate
    WS_1.Range("A1").AutoFilter
    'copy order id
    WS_2.Activate
    WS_2.Range("A2", Range("A2").End(xlDown)).Copy
    WS_3.Activate
    WS_3.Range("F2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'fill date, code, company name
    WS_3.Range("B2").FormulaR1C1 = "=RC[-1]+2"
    WS_3.Range("B2").AutoFill Destination:=Range("B2:B" & Range("F" & Rows.Count).End(xlUp).Row)
    WS_3.Range("D2").FormulaR1C1 = "1234567"
    WS_3.Range("D2").AutoFill Destination:=Range("D2:D" & Range("F" & Rows.Count).End(xlUp).Row)
    WS_3.Range("E2").FormulaR1C1 = "ABC"
    WS_3.Range("E2").AutoFill Destination:=Range("E2:E" & Range("F" & Rows.Count).End(xlUp).Row)
    WS_3.Range("G2").FormulaR1C1 = "=CONCATENATE(Sheet2!RC[12],"" "",Sheet2!RC[11])"
    WS_3.Range("G2").AutoFill Destination:=Range("G2:G" & Range("F" & Rows.Count).End(xlUp).Row)
    'fill address
    WS_2.Activate
    WS_2.Range("U2:V1000").Copy
    WS_3.Activate
    WS_3.Range("H2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'fill phone
    WS_2.Activate
    WS_2.Range("T2:T1000").Copy
    WS_3.Activate
    WS_3.Range("L2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    WS_2.Activate
    WS_2.Range("H2:H1000").Copy
    WS_3.Activate
    WS_3.Range("M2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'fill box, quantity, weight
    WS_3.Activate
    WS_3.Range("Q2").FormulaR1C1 = "box"
    WS_3.Range("Q2").AutoFill Destination:=Range("Q2:Q" & Range("F" & Rows.Count).End(xlUp).Row)
    WS_3.Range("R2").FormulaR1C1 = "1"
    WS_3.Range("R2").AutoFill Destination:=Range("R2:R" & Range("F" & Rows.Count).End(xlUp).Row)
    WS_3.Range("S2").FormulaR1C1 = "3"
    WS_3.Range("S2").AutoFill Destination:=Range("S2:S" & Range("F" & Rows.Count).End(xlUp).Row)
    'fill date
    Lr = WS_3.Range("A" & Rows.Count).End(xlUp).Row
    WS_3.Range("A" & Lr, WS_3.Range("B" & Rows.Count).End(xlUp).Offset(, -1)).FillDown
    'value
    WS_3.Cells.Copy
    WS_3.Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    'clear data in sheet2 if any
    WS_2.Activate
    WS_2.Cells.Delete Shift:=xlUp
    WS_1.Range("A1").AutoFilter
    'delete object and move
    WS_3.Activate
    WS_3.DrawingObjects.Delete
    WS_3.Copy
    WS_3.Name = "normal store"
    'clear data in sheet3 if any
    WS_3.Rows("2:1000").Delete
    With WS_3.Range("A2").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.499984740745262
        .PatternTintAndShade = 0
    End With

End Sub
Click to expand...
bstory84
thank you very much for you reply
i tried and it works unless:

VBA Code: 
    'fill date, code, company name
    Sheets("Sheet3").Select
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]+2"
    Selection.AutoFill Destination:=Range("B2:B" & Range("F" & Rows.Count).End(xlUp).Row)

when there is only 1 row can be copied from sheet 1 to sheet3, it stoped.
what should i need to amend the error?
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
Insert formula in last column macro
2
Replies
13
Views
215
MARK858
MARK858
Dazzawm
  • Solved
Change Range To Recorded Macro
Replies
3
Views
191
Alex Blakenburg
A
G
  • Question Question
Macro or VBA code for repeating a task but with different cell information each time
Replies
2
Views
154
gregg777
G
S
  • Solved
VBA autofilling code
Replies
6
Views
603
Peter_SSs
Peter_SSs
willow1985
  • Solved
VBA Run-time error 91 - Object variable or With block variable not set when trying to refresh data/Sleep
Replies
4
Views
400
willow1985
willow1985

Forum statistics

Threads
1,224,825
Messages
6,181,191
Members
453,021
Latest member
pingpong7117

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