VBA transit the formula

Maci3j

Board Regular
Joined
Apr 4, 2013
Messages
78
Office Version
  1. 365
Hi everyone,

I would like to ask you for help.
I recorded a macro which does three things:
- column A: transits the formula,
- column A, J, K, N: colors the column names in red,
- column F, G, H, J, K, L, M, N, O: changes the format to date.


This is the macro:

Sub OTIF()
'
' OTIF Macro
'

'
Sheets("OTIF").Select
Range("A2").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("A2:A1000")
Range("A2:A1000").Select
Columns("F:O").Select
Selection.NumberFormat = "m/d/yyyy"
Range("A1,J1:K1,N1").Select
Range("N1").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Sheets("Instructie").Select
End Sub


The issue:
I would like to adapt it so the formula in column A6 will be transited to A7 if cell B7 is not empty.
Could you please help me with it?

Thank you in advance!
Capture.PNG
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,147
Office Version
  1. 2016
Platform
  1. Windows
This is a worksheet event triggered. So copy this code in Worksheet module (not normal module).

Any change in Range("B2:B1000") will trigger the macro. If cell (refers as Target) is not blank, the code will copy formula from 1 row above and paste.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Range("B2", "B1000"), Target) Is Nothing Then
    If Not Len(Target) = 0 Then
        Range("A" & Target.Row).Offset(-1, 0).Copy
        Range("A" & Target.Row).PasteSpecial (xlPasteFormulas)
    End If
End If

End Sub
 

Maci3j

Board Regular
Joined
Apr 4, 2013
Messages
78
Office Version
  1. 365
This is a worksheet event triggered. So copy this code in Worksheet module (not normal module).

Any change in Range("B2:B1000") will trigger the macro. If cell (refers as Target) is not blank, the code will copy formula from 1 row above and paste.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Range("B2", "B1000"), Target) Is Nothing Then
    If Not Len(Target) = 0 Then
        Range("A" & Target.Row).Offset(-1, 0).Copy
        Range("A" & Target.Row).PasteSpecial (xlPasteFormulas)
    End If
End If

End Sub
unfortunately the code doesn't work.
I opened the VBA, dubble clicked on the Sheet2 (OTIF), pasted the code and saved it. Added a new value in B7 but there were no changes made in cell A7.
Did I do something wrong?
 

Attachments

  • Capture.PNG
    Capture.PNG
    50.6 KB · Views: 3

Maci3j

Board Regular
Joined
Apr 4, 2013
Messages
78
Office Version
  1. 365
This is a worksheet event triggered. So copy this code in Worksheet module (not normal module).

Any change in Range("B2:B1000") will trigger the macro. If cell (refers as Target) is not blank, the code will copy formula from 1 row above and paste.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Range("B2", "B1000"), Target) Is Nothing Then
    If Not Len(Target) = 0 Then
        Range("A" & Target.Row).Offset(-1, 0).Copy
        Range("A" & Target.Row).PasteSpecial (xlPasteFormulas)
    End If
End If

End Sub
I made a mistake in the selection.
@Zot thank you very much! the code works great!! :biggrin:
 

Maci3j

Board Regular
Joined
Apr 4, 2013
Messages
78
Office Version
  1. 365

ADVERTISEMENT

ok. I tried it again and the formula works.
However, the formula in column A only transits 4 rows lower.
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,147
Office Version
  1. 2016
Platform
  1. Windows
ok. I tried it again and the formula works.
However, the formula in column A only transits 4 rows lower.
I don't understand what you meant by 4 rows lower.

How do you enter data in column B? The macro is triggered whenever you enter data in column B. Do you copy a range and paste?

It would be help ful if you can use XL2BB to capture the sample above and paste here. The XL2BB is a great tool that will preserve the formula and etc. into pasted sample. This was those who are helping can immediately try possible solution. Most will hesitate to re-type data and just pass the question :)
 

Maci3j

Board Regular
Joined
Apr 4, 2013
Messages
78
Office Version
  1. 365

ADVERTISEMENT

Yes exactly. The formula in column A appears only when I enter the data manually in columns B and D (D is logical as the formula in column A is based on column D) but doesn't wont with copy and paste.

OTIF sjabloon 1111 - Copy - Copy.xlsm
ABCDEFGHIJ
1%key_purchase_order0VENDOR.Vendor Name%key_shopping_cart%key_purchase_order%key_goods_receiptsSC creation dateSC start dateSC end datePO item creation datePO Start date
22100148353/1ERIKS NV1001522764|00000000012100148353|00000000018001222133|0000000001|202022/04/201922/04/201922/04/201925/02/202025/02/2020
32100146909/1ERIKS NV1001600475|00000000012100146909|00000000018001263609|0000000001|202019/09/201919/09/201919/09/201916/01/202016/01/2020
43300434175/1ERIKS NV1001622695|00000000013300434175|00000000018001229447|0000000001|202025/10/201925/10/201928/10/201915/01/202015/01/2020
52100146512/1ERIKS NV1001649579|00000000012100146512|00000000018001221036|0000000001|202012/12/201912/12/201912/12/20198/01/20208/01/2020
63100115453/1ERIKS NV1001656213|00000000013100115453|00000000018001199586|0000000001|202031/12/201931/12/201931/12/20193/01/20203/01/2020
73100115453/2ERIKS NV1001656213|00000000023100115453|00000000028001200537|0000000002|202031/12/201931/12/201931/12/20193/01/20203/01/2020
83100115453/3ERIKS NV1001656213|00000000033100115453|00000000038001200537|0000000003|202031/12/201931/12/201931/12/20193/01/20203/01/2020
92100146347/1ERIKS NV1001656359|00000000012100146347|00000000018001199067|0000000001|20202/01/20202/01/20202/01/20202/01/20202/01/2020
102100146336/1ERIKS NV1001656388|00000000012100146336|00000000018001207142|0000000001|20202/01/20202/01/20202/01/20202/01/20202/01/2020
112100146336/2ERIKS NV1001656389|00000000012100146336|00000000028001200335|0000000002|20202/01/20202/01/20202/01/20202/01/20202/01/2020
122100146336/3ERIKS NV1001656394|00000000012100146336|00000000038001199717|0000000003|20202/01/20202/01/20202/01/20202/01/20202/01/2020
13
14
15
16
17
18
19
20
21
OTIF
Cell Formulas
RangeFormula
A2:A12A2=IF(D2="","",LEFT(D2&"|"&D2,(FIND("|",D2&"|"&D2,1)-1))&"/"&CONVERT(RIGHT(D2&"|"&D2,(FIND("|",D2&"|"&D2,1)-1)),"m","m"))
 

Maci3j

Board Regular
Joined
Apr 4, 2013
Messages
78
Office Version
  1. 365
In the mean time I thought about a better and more efficient solution.
The macro should do as follow: transit the formula from A2 below till the first empty cell in column B.

Could you please help me with it?
Thank you in advance
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,147
Office Version
  1. 2016
Platform
  1. Windows
In the mean time I thought about a better and more efficient solution.
The macro should do as follow: transit the formula from A2 below till the first empty cell in column B.

Could you please help me with it?
Thank you in advance
My understanding is:
For current code, when enter data in column B, the formula in column A will be copied from a row above.
Now you wanted formula in column A to be copied additional row ahead of the row in column B you have just entered data.
Something like this:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Range("B2", "B1000"), Target) Is Nothing Then
    If Not Len(Target) = 0 Then
        Range("A" & Target.Row).Offset(-1, 0).Copy
        Range(Range("A" & Target.Row), Range("A" & Target.Row).Offset(1)).PasteSpecial (xlPasteFormulas)
        Target.Select
        Application.CutCopyMode = False
    End If
End If

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,129,447
Messages
5,636,328
Members
416,914
Latest member
DWC199

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
Top