Macro instead of a formula

[MSchädler]

I'm trying to create a macro to replace a formula and I don't seem to succeed. So I'm asking for your help.

Situation: I’m using a formula incolumn M, row 2 to 65536 which fetches the content of
column V, row 2 to 65536.
The result in column M, row 2 has tobe as “P0000000”. In this example = P0000001 (because V2 is 1)
The actual formula I use in column Mis: =TEXT(V2;"P0000000")

I need Help: I’m looking for a macroto calculate the same result instead of the formula above. The macro is to runas soon as a digit is entered in cell column V and displays the result incolumn M.

Reason: I believe that a macro will speedup the calculation time in my sheet.

Any suggestions:
M.

 

[My Aswer Is This]

Re: Help needed for a macro instead of a formula

Try this:
This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("V2:V" & Cells(Rows.Count, "V").End(xlUp).Row)) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Target.Offset(, -9).Value = "P0000000" & Target.Value
End If
End Sub

 

[MSchädler]

Re: Help needed for a macro instead of a formula

Hi,
First of all,many thanks for your help and I can tell you that your macro by itself works fine!

What Iforgot to tell is, that this command has to works together with some othermacro in my sheet. When I insert this in my existing sheet I get a debuggingerror message.
Therefore,I have to be more specific of what I want to achieve.
The sheetset up is as shown and I have an active-x button to start the copy/paste macro.It takes the last active row, copies it and pastes it on row below, clearingsome cell contents.
[TABLE="width: 1162"]
<tbody>[TR]
[TD]DB number[/TD]
[TD="align: right"]B[/TD]
[TD="align: right"]C[/TD]
[TD="align: right"]D[/TD]
[TD="align: right"]E[/TD]
[TD="align: right"]F[/TD]
[TD="align: right"]G[/TD]
[TD="align: right"]H[/TD]
[TD="align: right"]I[/TD]
[TD="align: right"]J[/TD]
[TD]Process[/TD]
[TD]Type
(drop down)[/TD]
[TD]Proj.ID[/TD]
[TD="align: left"]

Date

<tbody>
</tbody>

[/TD]
[TD]ISP[/TD]
[TD]C[/TD]
[TD]Name[/TD]
[TD]S[/TD]
[TD]B[/TD]
[TD]FS[/TD]
[TD]R[/TD]
[TD]Proj.ID[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Initial[/TD]
[TD][/TD]
[TD]P0000001[/TD]
[TD="align: right"]29.05.2002[/TD]
[TD][/TD]
[TD][/TD]
[TD]Olten-Zürich[/TD]
[TD]OL-ZUE[/TD]
[TD][/TD]
[TD]#8_Planung[/TD]
[TD]1[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD="align: right"]2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Initial[/TD]
[TD][/TD]
[TD]P0000002[/TD]
[TD="align: right"]11.12.2002[/TD]
[TD][/TD]
[TD][/TD]
[TD]Bern-Wanzwil-Olten[/TD]
[TD="colspan: 2"]BN-WANZ-OL[/TD]
[TD]#8_Planung[/TD]
[TD]1[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD="align: right"]3[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Initial[/TD]
[TD][/TD]
[TD]P0000003[/TD]
[TD="align: right"]20.12.2002[/TD]
[TD][/TD]
[TD][/TD]
[TD]Basel-Olten[/TD]
[TD]BS-OL[/TD]
[TD][/TD]
[TD]#8_Planung[/TD]
[TD]1[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD="align: right"]4[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Initial[/TD]
[TD][/TD]
[TD]P0000004[/TD]
[TD="align: right"]20.12.2002[/TD]
[TD][/TD]
[TD][/TD]
[TD]Sierre-Brig[/TD]
[TD]SIE-BG[/TD]
[TD][/TD]
[TD]#8_Planung[/TD]
[TD]1[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD="align: right"]5[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Initial[/TD]
[TD][/TD]
[TD]P0000005[/TD]
[TD="align: right"]20.12.2002[/TD]
[TD][/TD]
[TD][/TD]
[TD]Sierre-Brig_NFP01[/TD]
[TD]SIE-BG[/TD]
[TD][/TD]
[TD]#8_Planung[/TD]
[TD]1[/TD]
[TD="align: right"]5[/TD]
[/TR]
[TR]
[TD="align: right"]6[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Initial[/TD]
[TD][/TD]
[TD]P0000006[/TD]
[TD="align: right"]20.12.2002[/TD]
[TD][/TD]
[TD][/TD]
[TD]Zofingen-Luzern[/TD]
[TD]ZF-LZ[/TD]
[TD][/TD]
[TD]#8_Planung[/TD]
[TD]1[/TD]
[TD="align: right"]6[/TD]
[/TR]
[TR]
[TD="align: right"]7[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Initial[/TD]
[TD][/TD]
[TD]P0000007[/TD]
[TD="align: right"]29.01.2003[/TD]
[TD][/TD]
[TD][/TD]
[TD]Pratteln-Brugg-Wettingen[/TD]
[TD]PR-WE[/TD]
[TD][/TD]
[TD]#8_Planung[/TD]
[TD]1[/TD]
[TD="align: right"]7[/TD]
[/TR]
[TR]
[TD="align: right"]8[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Initial[/TD]
[TD][/TD]
[TD]P0000008[/TD]
[TD="align: right"]12.12.2003[/TD]
[TD][/TD]
[TD][/TD]
[TD]Bellinzona-Locarno[/TD]
[TD]BEL-LO[/TD]
[TD][/TD]
[TD]#8_Planung[/TD]
[TD]1[/TD]
[TD="align: right"]8[/TD]
[/TR]
[TR]
[TD="align: right"]9[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Initial[/TD]
[TD][/TD]
[TD]P0000009[/TD]
[TD="align: right"]20.12.2003[/TD]
[TD][/TD]
[TD][/TD]
[TD]Effretikon-Wetzikon[/TD]
[TD]EF-WZ[/TD]
[TD][/TD]
[TD]#8_Planung[/TD]
[TD]1[/TD]
[TD="align: right"]9[/TD]
[/TR]
[TR]
[TD="align: right"]10[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Initial[/TD]
[TD][/TD]
[TD]P0000010[/TD]
[TD="align: right"]20.12.2003[/TD]
[TD][/TD]
[TD][/TD]
[TD]Frutigen-Raron (ATL)[/TD]
[TD]ATL, KTU[/TD]
[TD][/TD]
[TD]#8_Planung[/TD]
[TD]1[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD="align: right"]11[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Initial[/TD]
[TD][/TD]
[TD]P0000011[/TD]
[TD="align: right"]20.12.2003[/TD]
[TD][/TD]
[TD][/TD]
[TD]Seuzach-Winterthur Seen[/TD]
[TD="colspan: 2"]W-RW, W-SH[/TD]
[TD]#8_Planung[/TD]
[TD]1[/TD]
[TD="align: right"]11[/TD]
[/TR]
[TR]
[TD="align: right"]12[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Initial[/TD]
[TD][/TD]
[TD]P0000012[/TD]
[TD="align: right"]20.12.2003[/TD]
[TD][/TD]
[TD][/TD]
[TD]Thun-Frutigen-Brig (BLS)[/TD]
[TD]TH-BG[/TD]
[TD][/TD]
[TD]#8_Planung[/TD]
[TD]1[/TD]
[TD="align: right"]12[/TD]
[/TR]
[TR]
[TD="align: right"]13[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]27.09.2017[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
<strike></strike>
What I want to achieve within the existing macro is to incorporate a command, which copies the value of cell A of the last active row and inserts that Value in column M in the format "P0000000".
Example (from the setup)
Copy row 14, paste into row 15, clear cells K15 to M and O to T15.
Now take value of Cell A15, copy value and paste value into V15 (normal) and in M15 with a format “P0000000”.

The macro I’m using to copy/paste, clear is as follow and works, except it does not put value in M15 (expected P0000013) or V15 (expected 13).

Private Sub CommandButton1_Click()
Application.EnableEvents = False
Application.ScreenUpdating = False
myCheck = MsgBox("New project?", vbYesNo) ‘show message (Ja/Nein)
If myCheck = vbNo Then Exit Sub
ActiveSheet.Range("M65536").End(xlUp).EntireRow.Select 'Copy last row in table
Selection.Copy
ActiveSheet.Range("M65536").End(xlUp).Offset(1, 0).EntireRow.Select
Selection.Insert 'paste one row below
Range("N" & (ActiveCell.Row)).Value = Date 'insert actual date
Intersect(Range("K:M,O:T"), ActiveCell.EntireRow).ClearContents 'delete cell contents
Application.ScreenUpdating = True
Application.EnableEvents = True
ActiveSheet.Range("M65536").End(xlUp).Offset(1, 0).EntireRow.Select
Range("K" & (ActiveCell.Row)).Select 'place cursor into cell K of active row
End Sub

Thanks for your much appreciated help.
M.
<strike></strike>

<strike></strike>

 

[My Aswer Is This]

Re: Help needed for a macro instead of a formula

I believe someone else here at Mr. Excel will have to help you. I wrote the script you asked for. Now your asking for a lot more. And showing me a script you already have which does lot's of things.

 

[MSchädler]

Re: Help needed for a macro instead of a formula

Ok.
Thank you for your help and sorry for that confusion.

Should I place a new thread?
M.

 

[Fluff]

Re: Help needed for a macro instead of a formula

Is this what you're after

Private Sub CommandButton1_Click()

    Dim NxtRw As Long
    Dim MyCheck

Application.EnableEvents = False
Application.ScreenUpdating = False

    MyCheck = MsgBox("New project?", vbYesNo) 'show message (Ja/Nein)
    If MyCheck = vbNo Then Exit Sub
'
    NxtRw = Range("M" & Rows.Count).End(xlUp).Row + 1

    Rows(NxtRw - 1).Copy
    Rows(NxtRw).Insert
    Range("K" & NxtRw).Resize(, 10).ClearContents
    Range("N" & NxtRw).Value = Date
    Range("K" & NxtRw).Select
    Range("V" & NxtRw).Value = Range("A" & NxtRw).Value
    Range("M" & NxtRw).Value = Format(Range("V" & NxtRw).Value, "P0000000")

Application.EnableEvents = True

End Sub

 

[MSchädler]

Re: Help needed for a macro instead of a formula

Hi Fluff
Many thanks, this macro works quite well, except in column AI have an automatic row counter and I use the formula"=ZEILE()-1" for that. When you copy/paste you take that with you.

When you copy the last active row you paste it one below and that increments the counter in column A.
This is the value that I want to copy and insert in column"V" and as a specific format "P0000000" in column M. The expected value must be within the digit length (8 digits long).
In my sheet I use a cell formula to dothis =TEXT(V573;"P0000000") and that keeps any value within that length.

For example: I copy the full content of row 10.
A10 in this casehas the formula =Zeile()-1
This gets pasted on row 11 with all formulae.
The specific result I'm looking for is to have in row 11 column M the value "P0000011" and in column V the value "11".


I send you the link to my drop box with the test excel. This has my macro and might help.
https://www.dropbox.com/s/y6y0adcq5puzhmb/Test_Macro_P00.xlsm?dl=0
_{^{<strike>
</strike>}}
Thank you for your help!

Marc

 

[MSchädler]

Re: Help needed for a macro instead of a formula

Hello Fluff
In the mean time I've come up with the following vba. I'm sure it is not the best but for now it does the job. Maybe you can help to make it mor efficient?

This is the vba command:
Private Sub CommandButton3_Click()
Application.EnableEvents = False

myCheck = MsgBox("Create new project?", vbYesNo) 'Show message with (Yes/No))
If myCheck = vbNo Then Exit Sub
Application.ScreenUpdating = False 'do not update screen while processing
ActiveSheet.Range("M65536").End(xlUp).EntireRow.Select 'copy last row of column M
ActiveSheet.Range("M65536").End(xlUp).Offset(1, 0).EntireRow.Select
Selection.Insert 'paste one below last active row
ActiveSheet.Range("W1").Select 'fetch the value in W1. In W1 I have the formula:[=SMALL(if(COUNTIF($V:$V,ROW($V$1:$V$10000))=0,ROW($V$1:$V$10000)),ROW(W2)-1)] which find the smallest unused value in the counter.
Selection.Copy
ActiveSheet.Range("V65536").End(xlUp).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Range("N" & (ActiveCell.Row)).Value = Date 'set actual date
Intersect(Range("K:L,P:Q,S:T,AA:BC"), ActiveCell.EntireRow).ClearContents 'clear contents of cells in row
Application.ScreenUpdating = True
Application.EnableEvents = True

Range("K" & (ActiveCell.Row)).Select 'set cursor to front of row
End Sub

 

[MSchädler]

Re: Help needed for a macro instead of a formula

Here is the link to my drop box with the test sheet.
https://www.dropbox.com/s/dodz8e3zrycae89/Macro_Test_P000-1.xlsm?dl=0
M

 

[Fluff]

Re: Help needed for a macro instead of a formula

I have just tested the code I supplied in post#6 on your file & it does just what you're asking for.
That said, your new code (in post#8) is working on columns beyond V, but there is nothing in those columns on your test sheet.
You need to explain why the code I supplied does not work. Or I cannot help any further.