Appendix Thread. ( Codes for other Threads, etc.) Event Coding Drpdown Data validation

Printable View

Show 40 post(s) from this thread on one page

06-16-2020, 11:14 AM
DocAElstein

Appendix Thread. ( Codes for other Threads, HTML Tables, etc.) Event Coding

So my solution, which I will give in the next post will solve this problem, which is your problem shortened.

_____ Workbook: Autofill.xlsx ( Using Excel 2007 32 bit )

_Row\^Col
B

C

D

E

F

G

2

S. No.

Alpha Code

Sex

Category

Area

3

1

4

2

5

3

Worksheet: Sheet1
Case1
If I paste or enter A in cell C3, then, automatically put the value…
BOY in cell D3, GEN in cell E3 and URBAN in cell F3
Similarly,
If I paste or enter B in cell C3, then, automatically put the value…
BOY in cell D3, OBC in cell E3 and URBAN in cell F3
Similarly,
As shown in REFERENCE CHART)
the corresponding value should filled in the corresponding cells automatically
Now,
Similarly,
same condition is applied to cell C4, C5, C6 and so on
that is,
If I paste or enter A in cell C4, then, automatically put the value…
BOY in cell D4, GEN in cell E4 and URBAN in cell F4

_____ Workbook: Autofill.xlsx ( Using Excel 2007 32 bit )

_Row\^Col
R

S

T

U

V

W

1

REFERENCE CHART

2

S. No.

Alpha Code

Sex

Category

Area

3

1

A

BOY

GEN

URBAN

4

2

B

BOY

OBC

URBAN

5

3

C

BOY

SC

URBAN

6

4

D

BOY

ST

URBAN

7

5

E

GIRL

GEN

URBAN

Worksheet: Sheet1

Case2
If I paste or enter BOY in cell D3, GEN in cell E3 and URBAN in cell F3
then, automatically put the value A in cell C3
Similarly,
If I paste or enter BOY in cell D3, OBC in cell E3 and URBAN in cell F3
then, automatically put the value B in cell C3
06-16-2020, 11:14 AM
DocAElstein

post to get link for later use...

test

“Moderator” Notice

**I am Banning you to prevent you making any more postings here of the type you have been making here and elsewhere under hundreds of different user names at many of the English speaking Excel and Office help forums for the last couple of years.

The type of post that you have been posting suggest that
_ You may be one person or a !!team of many people working at something organised like a Call Centre.
( !! Sometime when you have been “caught” cross posting, you did not know yourself where you cross posted, and asked to be told. ( Or you maybe only wanted to admit to those where you got “caught”) )
_ You have almost no understanding of the English language
_ You may not have a computer and may have no access to Excel
_ You have no interest in Excel or Excel VBA
_ You have almost no knowledge or interest in any of the questions that you are asking
_ You may be simply offering a service of posting other peoples questions and supplying them with any answers you get.
_ You may be part of the development of a question asking and Replying Bot

_ In some cases, something extremely simple to understand, has been explained to you very many times, in great detail , even graphically, such that even a small mentally handicapped child could understand it and remember it. Despite this, you continually ask exactly that same question over and over again: If you are part of a team interested in only posting questions and taking the answer, then you are very badly organised,
Or
There is no real intelligence behind what is producing your questions and posts
_ One of the things you consistently do after receiving a macro is to delete all explanations, explaining 'comments and all files associated, and indeed it appears as if you try to remove almost all record of the coding and the question and answer. This further encourages the posting of the same or similar questions over and over again.

Whatever you are attempting to do, it appears to be extremely, almost insanely, inefficient ,
compared to
a single person with a computer and Excel, and a minimum of basic Excel VBA knowledge trying to achieve the same.

The main reason for the ban is
Whatever you are attempting to do, it is requiring 10-100 times more time than is typically required of helpers at a forum. All indications are that what you are doing will fail to achieve anything, and is therefore a total waste of everyone’s time. At excelfox, the current small number of helpers have only a limited amount of time, but even if we had more members, excelfox would not be the place for you## Some of the major forums may be a good place for you to post.

These are some suggestions, from me, on how you should continue
_ If you intend to continue, regardless of any of my previous suggestions, in postings of the type as you have done in the past, then you should think about making some changes to your wording, introduce some new canned replies, possibly organise a new set of similar questions and post at the major forums, such as mrexcel.com, excelforum.com, ozgrid.com
_ If you wish to make a career out of posting questions and getting answers without having any real intentions of thinking about anything, then excelfox is not the forum for you to post in. Most of the smaller forums are not the place for you. The larger forums may be able to accommodate you, if you give at least some thought to making it not quite so obvious: Your distinguishing characteristic is that you have been making it much more obvious than others doing the same, do: Many people do the such. At least half the traffic at such forums originates from such. I have passed many people on to such forums and they are making a successful career based on passing on the work done for them by helpers at the major forums. Such is actually encouraged, all be it , not openly, at the major forums.
_ If you have not understood most of this Moderator Notice , then your first priority should be to improve on your English. Indeed, your apparent understanding and ability in communicating in English suggests that you will achieve nothing whatsoever and fail completely in anything at all involving communicating in English.

_ If you are, as you sometimes told me via PM, actively working on an important personal problem requiring VBA , then you are doing it totally wrongly: You have been on the project already for at least two years and have a mixed up set of codings produced by many different people. Some work . Some don’t. You have not the slightest idea or understanding of any of the codings. You will never be able to use them to any effect. If , on the other hand, you had a computer, with Excel, and spent a few weeks learning VBA, and then carefully studied all the macros that you have been given, then you would be able to answer most of your further questions, and would have at least a chance of being able to use the codings effectively:-
1 Month learn VBA and 1 month getting answers, partly alone, partly with help from forums = Finished Success
2+ Years posting the same and similar questions and just taking the answers = Never Ending Fail
_ It is unlikely that the macros you have that work will ever be very efficient and will likely be slower than anyone else’s: They will certainly not be the best possible. Giving you better coding has proved to be impossible: It is not possible to pass on better codings because of the ridiculously inefficient way that you are organising whatever it is that you are doing: The person receiving and passing on the coding needs to understand the English language and to understand some basic coding and to understand how to use such better coding. We have tried this a few times, but it proved always completely impossible to do. One example of this is the issue of text files: Because you are mostly dealing with values, the use of text files is almost certainly beneficial and in some cases the only efficient way to proceed. You have completely missed the point on this: You have repeated much work to try to avoid using text files. The problem was, and will never be, the issue of text files themselves. The issue is your total inability or unwillingness to understand anything at all about them.

##The main purpose of the question section of excelfox is approximately the following:
_1. Promote and improve the understanding of Excel and Excel VBA.
_2. Help people who get stuck on a problem and/or help people who are unsure how to proceed in solving a problem using Excel and Excel VBA.

Your objectives??
I do not know what the true reason is behind your postings. I can’t believe anything you say is your purpose, since you have lied and contradicted yourself in the past. The only thing we know 100% for sure is that your posting types are not for any of the purposes for which the question section of excelfox is intended.
You have had the benefit of the doubt given to you now very many times. You have had lots of chances.
You may be able to continue at some of the major forums, where some people are happy to continue to spend time to answer similar questions from the same source.
I do not think you will get any more replies to the types of postings you have been making at excelfox or at any other of the smaller English speaking Forums. You are wasting your time making any such posts from now on.
**I am Banning you, not as any form of punishment, but purely as in the past , it has proven to be the only way to prevent you wasting yours and other peoples time with your postings.
I do wish you luck and success with what ever it is you are attempting to do. But you should not be doing it at excelfox.
If you are attempting the personal project that you have told me about via PM, then you are going about it in completely the wrong way.
If you are trying to make a career of posting other people’s questions and getting answers for them, then you should post mostly at the major forums and organise yourself better: At least have access to Excel on a computer and learn the basics of VBA. If you are trying to make a career of posting other people’s questions and getting answers for them, as many people do, then you have made the mistake of making it too obvious. Many of the senior helpers at the main forums prefer to think that they are helping people rather than doing their work for them. What they don’t know, does not hurt them. :)

I will leave all your posts in the main forum for a few weeks. Then I will move them all to the test forum. I will probably further merge them. Eventually I may delete them all.

Bro, whatever you are trying to do, its not working. Its never going to work. Its just wasting everybody’s time.
You need first to learn English
Then get a computer.
Then learn some basic Excel and Excel VBA
Then start again.

I have not been so impressed with my flower efforts this Summer. I will give Petra the blame for that: Do you remember my great success with the Sun Flowers in the wheelbarrow (https://imgur.com/hF1B4I1 )
Well Petra was not so impressed, she didn’t think it was so nice a wheelbarrow exploding with Sun Flowers, so as a compromise we said we would do it every other year.
But at the end of last year I must have got a few hundred seeds from the flowers. I planted about 100 of them all over the place at the start this year.
It was not a great success, possibly because we have so much shade, almost everywhere. I only noticed 3 growing, 2 still have not got very far. But a combination of intelligence and some nice late Summer sun has got the one up and he is letting everyone see him ….. first it grew about 80cm vertically to get out of the shade, then when it got out in the open it shot up.
https://imgur.com/IRW78eD
https://imgur.com/xKSfRU9
The clever Sun Flower. I must make a point of saving his seeds. ….
07-12-2020, 05:32 PM
DocAElstein

Macro for this post
https://excelfox.com/forum/showthrea...ll=1#post14572

_ 4.
This is easy, simply convert the Target.Value to UCase(Target.Value) , and use that converted character in place of Target.Value
( If the Target.Value is already uppercase, then UCase(Target.Value) will not error - Target.Value will just stay as it is )

_ 2. And 3.
This is not difficult, but need s some juggling around with code lines
Two similar code sections are needed

_1. This is a bit more difficult. It is rather unusual not to have a range of the required LookUp information somewhere
This information must come from somewhere.
The most simple solution would be to have that range somewhere
For now , I have put the information on a second worksheet. And made a minor change to the macro to reference that worksheet
If this is not acceptable, then I can put the information somewhere else, such as in the macro itself.

So here is my next solution for you.
Once again for now, for clarity and simplicity, I have limited it just to a few rows

Code:

Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Bed If Application.Intersect(Target, Me.Range("C3:F5")) Is Nothing Then Exit Sub ' No overlap with the entry range, so exit sub ' Case1 If Not Application.Intersect(Target, Me.Range("C3:C5")) Is Nothing Then ' Column C entry If IsArray(Target.Value) Then Exit Sub ' more than one cell selected, but this procedure can only work on single cell entries in column C If Target.Value = "" Then 'This would be a cleared cell ( deleted value ) Let Application.EnableEvents = False ' This is to prevent the worksheet change in the next code line setting off this procedure again Let Target.Offset(0, 1).Resize(1, 3).Value = "" ' If I delete the Alpha Code from a cell (for example C3), the corresponding range (D3:F3) should be empty/deleted automatically. Let Application.EnableEvents = True ElseIf Len(Target.Value) <> 1 Then Exit Sub ' we have an entry , but it is invalid Else End If Dim UcsTgtVl As String: Let UcsTgtVl = UCase(Target.Value) If InStr(1, ",A,B,C,D,E,", "," & UcsTgtVl & ",", vbBinaryCompare) = 0 Then Exit Sub Dim PosS As Long: Let PosS = (InStr(1, ",A,B,C,D,E,", UcsTgtVl, vbBinaryCompare) / 2) + 2 ' Row number in REFERENCE CHART for the corrsponding Sex Category Area values Let Application.EnableEvents = False ' This is to prevent the worksheet change in the next code line setting off this procedure again Let Target.Offset(0, 1).Resize(1, 3).Value = ThisWorkbook.Worksheets("REFERENCE CHART").Range("T" & PosS & ":V" & PosS & "").Value Let Application.EnableEvents = True ' Case2 ElseIf Not Application.Intersect(Target, Me.Range("D3:F5")) Is Nothing Then ' Entry in column D E or F If Target.Columns.Count = 1 Then If Target.Value = "" Then 'This would be a cleared cell ( deleted value ) Let Application.EnableEvents = False ' This is to prevent the worksheet change in the next code line setting off this procedure again Let Me.Range("C" & Target.Row & "").Value = "" ' If I delete any one cell value from the range (for example D3:F3), the corresponding Alpha Code (C3) should be deleted automatically. It means, the Alpha Code should be appear only if all the three cells in the corresponding range (for example D3:F3) are filled. Otherwise, the Alpha Code should be disappear/deleted. Let Application.EnableEvents = True Exit Sub Else End If ElseIf Target.Rows.Count <> 1 Then Exit Sub ' more than 1 row selected, but this procedure can only work on single row entries Else End If Dim arrSCA() As Variant: Let arrSCA() = Array("BOYGENURBAN", "BOYOBCURBAN", "BOYSCURBAN", "BOYSTURBAN", "GIRLGENURBAN") Dim TrgtRw As Long: Let TrgtRw = Target.Row Dim DEF As String: Let DEF = Me.Range("D" & TrgtRw).Value & Me.Range("E" & TrgtRw).Value & Me.Range("F" & TrgtRw).Value Dim Mtchres As Variant Let Mtchres = Application.Match(DEF, arrSCA, 0) If IsError(Mtchres) Then Exit Sub ' no matching set of entries in columns D E and F Dim PosS2 As Long: Let PosS2 = Mtchres + 2 ' Row number in REFERENCE CHART for the corresponding Alpha Code Let Application.EnableEvents = False Let Me.Range("C" & TrgtRw & "").Value = Me.Range("S" & PosS2 & "").Value Let Application.EnableEvents = True Else End If Bed: ' just incase anything goes wrong, it is a good idea to make sure that things are turned back to normal Let Application.EnableEvents = True End Sub

Share ‘Autofill.xlsm’ : https://app.box.com/s/mt1c2xvdejjj6d3vjo6wkjyrdxrs98tm
08-27-2020, 03:33 PM
DocAElstein

Post for later use

“Moderator” Notice

**I am Banning you to prevent you making any more postings here of the type you have been making here and elsewhere under hundreds of different user names at many of the English speaking Excel and Office help forums for the last couple of years.

The type of post that you have been posting suggest that
_ You may be one person or a !!team of many people working at something organised like a Call Centre.
( !! Sometime when you have been “caught” cross posting, you did not know yourself where you cross posted, and asked to be told. ( Or you maybe only wanted to admit to those where you got “caught”) )
_ You have almost no understanding of the English language
_ You may not have a computer and may have no access to Excel
_ You have no interest in Excel or Excel VBA
_ You have almost no knowledge or interest in any of the questions that you are asking
_ You may be simply offering a service of posting other peoples questions and supplying them with any answers you get.
_ You may be part of the development of a question asking and Replying Bot

_ In some cases, something extremely simple to understand, has been explained to you in great detail , even graphically, such that even a small mentally handicapped child could understand it and remember it. Despite this, you continually ask exactly that same question over and over again: If you are part of a team interested in only posting questions and taking the answer, then you are very badly organised,
Or
There is no real intelligence behind what is producing your questions and posts
_ One of the things you consistently do after receiving a macro is to delete all explanations, explaining 'comments and all files associated, and indeed it appears as if you try to remove almost all record of the coding and the question and answer. This further encourages the posting of the same or similar questions over and over again.

Whatever you are attempting to do, it appears to be extremely, almost insanely, inefficient ,
compared to
a single person with a computer and Excel, and a minimum of basic Excel VBA knowledge trying to achieve the same.

The main reason for the ban is
Whatever you are attempting to do, it is requiring 10-100 times more time than is typically required of helpers at a forum. All indications are that what you are doing will fail to achieve anything, and is therefore a total waste of everyone’s time. At excelfox, the current small number of helpers have only a limited amount of time, but even if we had more members, excelfox would not be the place for you## Some of the major forums may be a good place for you to post.

These are some suggestions, from me, on how you should continue
_ If you intend to continue, regardless of any of my previous suggestions, in postings of the type as you have done in the past, then you should think about making some changes to your wording, introduce some new canned replies, possibly organise a new set of similar questions and post at the major forums, such as mrexcel.com, excelforum.com, ozgrid.com
_ If you wish to make a career out of posting questions and getting answers with out having any real intentions of thinking about anything, then excelfox is not the forum for you to post in. Most of the smaller forums are not the place for you. The larger forums may be able to accommodate you, if you give at least some thought to making it not quite so obvious: Your distinguishing characteristic is that ylou have been making it much more obvious than others doing the same, do: Many people do the such. At least half the traffic at such forums originates from such. I have passed many people on to such forums and they are making a successful career based on passing on the work done for them by helpers at the major forums. Such is actually encouraged, all be it , not openly, at the major forums.
_ If you have not understood most of this Moderator Notice , then your first priority should be to improve on your English. Indeed, your apparent understanding and ability in communicating in English suggests that you will achieve nothing whatsoever and fail completely in anything at all involving communicating in English.

_ If you are, as you sometimes told me via PM, actively working on an important personal problem requiring VBA , then you are doing it totally wrongly: You have been on the project already for at least two years and have a mixed up set of codings produced by many different people. Some work . Some don’t. You have not the slightest idea or understanding of any of the codings. You will never be able to use them to any effect. If , on the other hand, you had a computer, with Excel, and spent a few weeks learning VBA, and then carefully studied all the macros that you have been given, then you would be able to answer most of your further questions, and would have at least a chance of being able to use the codings effectively:-
1 Month learn VBA – 1 month getting answers, partly alone, partly with help from forums = Finished Success
2+ Years posting almost the same questions and just taking the answers = Never Ending Fail

##The main purpose of the question section of excelfox is approximately the following:
_1. Promote and improve the understanding of Excel and Excel VBA.
_2. Help people who get stuck on a problem and/or help people who are unsure how to proceed in solving a problem using Excel and Excel VBA.

Your objectives??
I do not know what the true reason is behind your postings. I can’t believe anything you say is your purpose, since you have lied and contradicted yourself in the past. The only thing we know 100% for sure is that your posting types are not for any of the purposes for which the question section of excelfox is intended.
You have had the benefit of the doubt given to you now very many times. You have had lots of chances.
You may be able to continue at some of the major forums, where some people are happy to continue to spend time to answer similar questions from the same source.
I do not think you will get any more replies to the types of postings you have been making at excelfox or at any other of the smaller English speaking Forums. You are wasting your time making any such posts from now on.
**I am Banning you, not as any form of punishment, but purely as in the past , it has proven to be the only way to prevent you wasting yours and other peoples time with your postings.
I do wish you luck and success with what ever it is you are attempting to do. But you should not be doing it at excelfox.
If you are attempting the personal project that you have told me about via PM, then you are going about it in completely the wrong way.
If you are trying to make a career of posting other people’s questions and getting answers for them, then you should post mostly at the major forums and organise yourself better: At least have access to Excel on a computer and learn the basics of VBA. If you are trying to make a career of posting other people’s questions and getting answers for them, as many people do, then you have made the mistake of making it too obvious. Many of the senior helpers at the main forums prefer to think that they are helping people rather than doing their work for them. What they don’t know, does not hurt them. :)
08-27-2020, 03:34 PM
DocAElstein

Post for later use _

_Row\^Col	R	S	T	U	V
1	REFERENCE CHART
2	S. No.	Alpha Code	Sex	Category	Area
3	1	A	BOY	GEN	URBAN
4	2	B	BOY	OBC	URBAN
5	3	C	BOY	SC	URBAN
6	4	D	BOY	ST	URBAN
7	5	E	GIRL	GEN	URBAN

Worked example for this Thread
https://excelfox.com/forum/showthrea...sult-is-change

Before: as supplied by OP

_____ Workbook: help0824.xls ( Using Excel 2007 32 bit )

_Row\^Col A B C D E F G H I J K

15 ITEM DESCRIPTION QTY UNIT UNIT PRICE TOTAL AMOUNT REMARKS

16 1 3 30 90

17

18 2 20 1.5 30

19 3 4 55 220

20

21 4 1 250 250

22

23

24

25

26

27

28

29

30

31

32

33

34

35 Total 7 310.00

Worksheet: Sheet2

After
The macro is an events coding macro so it starts automatically,
....For example, I do the given example... ....'Example:
'Suppose the user fills in 3 in Cell G20, user fills in 15.25 in Cell I20 ,
'the serial number of Cell A20 serial number will automatic become 4,
' and the original 4 of cell A21 will automatically become 5
'
'At this time, G35 original is 7 , will automatically calculates 10,
' J20 automatically calculates 45.75
'At this time, J35 original is 310 , will automatically calculates 355.75

_____ Workbook: help0824.xls ( Using Excel 2007 32 bit )

_Row\^Col A B C D E F G H I J K

15 ITEM DESCRIPTION QTY UNIT UNIT PRICE TOTAL AMOUNT REMARKS

16 1 3 30 90

17

18 2 20 1.5 30

19 3 4 55 220

20 4 3 15.25 45.75

21 5 1 250 250

22

23

24

25

26

27

28

29

30

31

32

33

34

35 Total 10 355.75

Worksheet: Sheet2

08-27-2020, 03:43 PM
DocAElstein

Macro for last post, and for answer to this Thread
https://excelfox.com/forum/showthrea...ll=1#post14831

Code:

Public Sub Worksheet_Change(ByVal Target As Range) If Not Application.Intersect(Target, Range("G16:G34")) Is Nothing Or Not Application.Intersect(Target, Range("I16:I34")) Is Nothing Then ' we only go any further if we have an intersect between Target - the range we changed, and one of the column ranges of interest If Range("A" & Target.Row & "").Value2 = "" Then ' We are only intertsted in putting a value in column A to update an ittem number if there is not already one in there ' get current maximum item number info: wjat is it, and where is it Dim Cnt As Long, Mx As Long, MxInd As Long ' MxInd is for the Item number at which we got the maximum , - I need this to know where to put the new ITEM Dim RngA As Range: Set RngA = Range("A16:A34") For Cnt = 1 To RngA.Rows.Count Step 1 If Mx < RngA.Item(Cnt).Value Then ' In Excel Ranges cell item numbers are counted along columns then next rows etc. So for a single column, each next item number is the next row Let Mx = RngA.Item(Cnt).Value Let MxInd = Cnt Else End If Next Cnt ' update current row item number to be the current highest, and make previous highest one more Let Application.EnableEvents = False ' I have to temporarily turn this thing off, or else the next line makes this macro start again Let Range("A" & Target.Row & "").Value2 = Mx: Let RngA.Item(MxInd).Value2 = Mx + 1 Let Application.EnableEvents = True Else ' Column A already has a number in so no item number update End If ' Doing the sum calculations Dim RngG As Range: Set RngG = Range("G16:G34") Dim RngJ As Range: Set RngJ = Range("J16:J34") For Cnt = 1 To RngG.Rows.Count Step 1 Dim SumG As Double If RngG.Item(Cnt).Font.Strikethrough = False And RngG.Item(Cnt).Value2 <> "" Then Let SumG = SumG + RngG.Item(Cnt).Value2 Else ' there is no value or it is struck through End If Dim SumJ As Double If RngJ.Item(Cnt).Font.Strikethrough = False And RngJ.Item(Cnt).Value2 <> "" Then Let SumJ = SumJ + RngJ.Item(Cnt).Value2 Else ' there is no value or it is struck through End If Next Cnt Let Application.EnableEvents = False Let Range("G35").Value2 = SumG: Let Range("J35").Value2 = SumJ Let Application.EnableEvents = True Else ' did not make change in column ranges of interset End If End Sub
08-28-2020, 12:51 PM
DocAElstein

Second solution for this Thread
https://excelfox.com/forum/showthrea...sult-is-change

Looking at jindon’s solution at the cross post:
https://www.excelforum.com/excel-pro...is-change.html

Jindon has done a function to do the summing of the columns G and J

He sugest that, for example you place then in cell J35
=SumIfClear(J16:J34) https://www.excelforum.com/excel-pro...ml#post5386274

What this does is , taken in the column range, rng , and return the sum value as required.
It does it like this:
' make a range object , x , of a few areas, each area being a row with a “shape with a name Like "Line*"
' The sum calculation is then done only taking row values in the column, range , rng , which do not intersect with the range of rows with a shape, x

Code:

Option Explicit ' https://www.excelforum.com/excel-programming-vba-macros/1325405-reserve-the-horizontal-line-numbers-and-information-but-the-calculation-result-is-change.html Sub CallSumIfClear() Call SumIfClear(Range("J16:J34")) End Sub Function SumIfClear(rng As Range) As Double Dim r As Range, x As Range, Sp As Shape 'Application.Volatile ' make a range object of a few areas, each area being a row with a shape with a name Like "Line*" For Each Sp In rng.Worksheet.Shapes If Sp.Name Like "Line*" Then If x Is Nothing Then Set x = Range(Sp.TopLeftCell, Sp.BottomRightCell) Else Set x = Union(x, Range(Sp.TopLeftCell, Sp.BottomRightCell)) End If End If Next ' The sum calculation For Each r In rng If Intersect(r, x) Is Nothing Then SumIfClear = SumIfClear + Val(r.Value) Next End Function

( The formula given by Jindon is no good as it does not answer the question )

Jindon’s formula has shown me how to determine where shapes ( like a line ) are.
So I could, for example, build a string of the row numbers with a shape in

For example this next macro , will return, for the sample data, in the variable, strLnRws ,
__18__21__

Code:

Sub BuildStingOfRowsWithShapeLine() Dim strLnRws As String: Let strLnRws = " " Dim RngG As Range: Set RngG = Range("G16:G34") Dim Sp As Shape For Each Sp In RngG.Worksheet.Shapes If Sp.Name Like "Line*" Then Let strLnRws = strLnRws & Sp.TopLeftCell.Row & " " Else End If Next Debug.Print strLnRws ' From VB Editor , hit keys Ctrl + g to get the immediate window to see the contents End Sub

I can check for the rows so as not to sum those rows. ( Note I will check for a string of “ “ & TheRowNumber & “ “ , as this will avoid errors caused by checking for , for example 3 , when I have a row of 436 : If I checked for 3 , I would find it if I had 436 , which would be incorrect )

For example, the Instr function can be used to see if a row number is present in that strLnRws. Thuis is implimented in the example below to get the sum for column G

Code:

Sub BuildStingOfRowsWithShapeLineAndSumColumnIfNoShapeLine() Dim strLnRws As String: Let strLnRws = " " Dim RngG As Range: Set RngG = Range("G16:G34") Dim Sp As Shape For Each Sp In RngG.Worksheet.Shapes If Sp.Name Like "Line*" Then Let strLnRws = strLnRws & Sp.TopLeftCell.Row & " " Else End If Next Debug.Print strLnRws ' From VB Editor , hit keys Ctrl + g to get the immediate window to see the contents Dim Cnt For Cnt = 1 To RngG.Rows.Count Step 1 Dim SumG As Double If InStr(1, strLnRws, " " & RngG.Item(Cnt).Row & " ", vbBinaryCompare) = 0 And RngG.Item(Cnt).Value2 <> "" Then ' InStr will return a 0 if the rows number is not present in the string strLnRws Let SumG = SumG + RngG.Item(Cnt).Value2 Else ' there is no value or it is struck through End If Next Cnt Debug.Print SumG End Sub

Using the above information we can write a second event coding macro which this time will work on the original worksheet: there is no longer a need to modify the range to have strikethroughs:
See next post
08-28-2020, 01:21 PM
DocAElstein

1 Attachment(s)

Macro for last post, and for second answer to this Thread
https://excelfox.com/forum/showthrea...ll=1#post14831

Code:

Public Sub Worksheet_Change(ByVal Target As Range) If Not Application.Intersect(Target, Range("G16:G34")) Is Nothing Or Not Application.Intersect(Target, Range("I16:I34")) Is Nothing Then ' we only go any further if we have an intersect between Target - the range we changed, and one of the column ranges of interest If Range("A" & Target.Row & "").Value2 = "" Then ' We are only intertsted in putting a value in column A to update an ittem number if there is not already one in there ' get current maximum item number info: wjat is it, and where is it Dim Cnt As Long, Mx As Long, MxInd As Long ' MxInd is for the Item number at which we got the maximum , - I need this to know where to put the new ITEM Dim RngA As Range: Set RngA = Range("A16:A34") For Cnt = 1 To RngA.Rows.Count Step 1 If Mx < RngA.Item(Cnt).Value Then ' In Excel Ranges cell item numbers are counted along columns then next rows etc. So for a single column, each next item number is the next row Let Mx = RngA.Item(Cnt).Value Let MxInd = Cnt Else End If Next Cnt ' update current row item number to be the current highest, and make previous highest one more Let Application.EnableEvents = False ' I have to temporarily turn this thing off, or else the next line makes this macro start again Let Range("A" & Target.Row & "").Value2 = Mx: Let RngA.Item(MxInd).Value2 = Mx + 1 Let Application.EnableEvents = True Else ' Column A already has a number in so no item number update End If ' Doing the sum calculations Dim RngG As Range: Set RngG = Range("G16:G34") ' Build Sting Of Rows With Shape Line And Sum Column If No Shape Line https://excelfox.com/forum/showthread.php/2561-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)-Event-Coding?p=14844&viewfull=1#post14844 Dim strLnRws As String: Let strLnRws = " " Dim Sp As Shape For Each Sp In RngG.Worksheet.Shapes If Sp.Name Like "Line*" Then Let strLnRws = strLnRws & Sp.TopLeftCell.Row & " " Else End If Next Dim RngJ As Range: Set RngJ = Range("J16:J34") For Cnt = 1 To RngG.Rows.Count Step 1 Dim SumG As Double If InStr(1, strLnRws, " " & RngG.Item(Cnt).Row & " ", vbBinaryCompare) = 0 And RngG.Item(Cnt).Value2 <> "" Then Let SumG = SumG + RngG.Item(Cnt).Value2 Else ' there is no value or it is struck through End If Dim SumJ As Double If InStr(1, strLnRws, " " & RngJ.Item(Cnt).Row & " ", vbBinaryCompare) = 0 And RngJ.Item(Cnt).Value2 <> "" Then Let SumJ = SumJ + RngJ.Item(Cnt).Value2 Else ' there is no value or it is struck through End If Next Cnt Let Application.EnableEvents = False Let Range("G35").Value2 = SumG: Let Range("J35").Value2 = SumJ Let Application.EnableEvents = True Else ' did not make change in column ranges of interset End If End Sub

I have put this in the worksheet object code module of worksheet "Sheet2 excelforum jindon" in the uploaded file: -
help0824.xls : https://app.box.com/s/fkfuld8yk4xrna5vt069x75intiyzs8i
08-29-2020, 03:40 AM
DocAElstein

Macro for this post
https://excelfox.com/forum/showthrea...ll=1#post14848

In ThisWorkbook code module

Code:

Option Explicit Private Sub Workbook_Open() Let Sheet3.UsdRws = Worksheets.Item(3).UsedRange.Rows.Count End Sub

In third worksheets object code module

Code:

Option Explicit Public UsdRws As Long Public Sub Worksheet_Change(ByVal Target As Range) If Me.UsedRange.Rows.Count = UsdRws + 1 Then ' We added a row Let Application.EnableEvents = False Let Range("J" & Target.Row & "").Value = "=IF(OR(RC[-3]="""",RC[-1]=""""),"""",RC[-3]*RC[-1])" Let Application.EnableEvents = True Let UsdRws = UsdRws + 1 Exit Sub ' No more will be done after a row insert Else End If If Not Application.Intersect(Target, Range("G16:G34")) Is Nothing Or Not Application.Intersect(Target, Range("I16:I34")) Is Nothing Then ' we only go any further if we have an intersect between Target - the range we changed, and one of the column ranges of interest Note: this would also be set off by a row insertion, but we will not let it because we exited before ' Dynamic Lr Dim Lr As Long: Let Lr = Range("J" & Rows.Count & "").End(xlUp).Row - 1 If Range("A" & Target.Row & "").Value2 = "" Then ' We are only intertsted in putting a value in column A to update an ittem number if there is not already one in there Let Application.EnableEvents = False Let Range("A" & Target.Row & "").Value2 = "anything" ' Put anything in for now Let Application.EnableEvents = True Dim RngA As Range: Set RngA = Range("A16:A" & Lr & "") Dim Cnt As Long, ACel As Range For Each ACel In RngA.SpecialCells(xlCellTypeConstants) ' Each cell with something in it in column A Let Cnt = Cnt + 1 Let Application.EnableEvents = False Let ACel.Value = Cnt ' The next cell down is given the next number Let Application.EnableEvents = True Next ACel Else ' Column A already has a number in so no item number update End If ' Doing the sum calculations Dim RngG As Range: Set RngG = Range("G16:G" & Lr & "") ' Build Sting Of Rows With Shape Line And Sum Column If No Shape Line https://excelfox.com/forum/showthread.php/2561-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)-Event-Coding?p=14844&viewfull=1#post14844 Dim strLnRws As String: Let strLnRws = " " Dim Sp As Shape For Each Sp In RngG.Worksheet.Shapes If Sp.Name Like "Line*" Then Let strLnRws = strLnRws & Sp.TopLeftCell.Row & " " Else End If Next Dim RngJ As Range: Set RngJ = Range("J16:J" & Lr & "") For Cnt = 1 To RngG.Rows.Count Step 1 Dim SumG As Double If InStr(1, strLnRws, " " & RngG.Item(Cnt).Row & " ", vbBinaryCompare) = 0 And RngG.Item(Cnt).Value2 <> "" Then Let SumG = SumG + RngG.Item(Cnt).Value2 Else ' there is no value or it is struck through End If Dim SumJ As Double If InStr(1, strLnRws, " " & RngJ.Item(Cnt).Row & " ", vbBinaryCompare) = 0 And RngJ.Item(Cnt).Value2 <> "" Then Let SumJ = SumJ + RngJ.Item(Cnt).Value2 Else ' there is no value or it is struck through End If Next Cnt Let Application.EnableEvents = False Let Range("G" & Lr + 1 & "").Value2 = SumG: Let Range("J" & Lr + 1 & "").Value2 = SumJ Let Application.EnableEvents = True Else ' did not make change in column ranges of interset End If End Sub

Show 40 post(s) from this thread on one page

_Row\^Col	A	B	G	H	I	J	K
15	ITEM	DESCRIPTION	QTY	UNIT	UNIT PRICE	TOTAL AMOUNT	REMARKS
16	1		3		30	90
17
18	2		20		1.5	30
19	3		4		55	220
20
21	4		1		250	250
22
23
24
25
26
27
28
29
30
31
32
33
34
35		Total	7			310.00