3 Case Scenario VBA Code

[jalrs]

Hello guys,

I don't know how to approach this nor if it is the right request to make. I believe with the attached screenshots will make it easier to understand.
So what I would like to is:

1st : Check each material on column C
2nd: 1st case - If the sum of column M is equal to 0 for each material, then delete those lines (water on the example)
2nd case - If the sum of column M is # 0 for each material, then leave it like that (coke on the example)
3rd case - If the sum of column M is # 0 and column L is greater than 0, add a new line under the one where column L is greater than 0 where column K = K-L from previous row, colum L is now 0, and column M equals to column K value. Plus Column E new line is +1 regarding the previous line value. Rest of the values should be equal to the ones on the previous line, except for the date that should be left empty. (tea example. date not correct on the output.png sorry)

Hope this is possible and hope someone can help me.

Please look at the input vs output attachment.

Any help is greatly appreciated.

Thanks

 

[jalrs]

With Xl2BB, format may change and different from it appears.
Just play around with format function as my last row of code.
Try it.

Ok bebo, thank you.

I will play around it and see.

Thanks

 

[jalrs]

With Xl2BB, format may change and different from it appears.
Just play around with format function as my last row of code.
Try it.

Hey bebo,

Current point of situation:
I managed to get what was missing by deleting the output sheet, and making a copy of the input sheet and renaming it to desired name, "Play" in this case.
This should be something related to conditional formatting? No clue though

I am only missing one thing and believe you could help me.

When, on column F, we add +1 comparing to previous row column F number, the new column number is being displayed on the right (stored as number I believe), and I need them to be displayed on the left (stored as text) I believe? At least I notice like a green flag on the ones displayed on the left side, green flag on the upper left corner of each cell, when I click on them, they are shown as " '0001 "

Hope it is fixable,

Thanks!

 

[Alex Blakenburg]

If your issue is that columns B & E don't show the leading zeroes change this section to what I have here:

    With Worksheets("Play")
        .Range("A2:M100000").ClearContents
        .Range("B2").Resize(k, 1).NumberFormat = "@"
        .Range("E2").Resize(k, 1).NumberFormat = "@"
        .Range("A2").Resize(k, 13).Value = arr
        '.Range("E2").Resize(k, 1).NumberFormat = "00000" ' Format column E - XXX Commented out replaced above
    End With

 

[jalrs]

If your issue is that columns B & E don't show the leading zeroes change this section to what I have here:

    With Worksheets("Play")
        .Range("A2:M100000").ClearContents
        .Range("B2").Resize(k, 1).NumberFormat = "@"
        .Range("E2").Resize(k, 1).NumberFormat = "@"
        .Range("A2").Resize(k, 13).Value = arr
        '.Range("E2").Resize(k, 1).NumberFormat = "00000" ' Format column E - XXX Commented out replaced above
    End With

Hey Alex,

Thanks for your reply, the above output is as follows on the attachment.
Cells marked as red are the new line ones, and should appear on the same format as their former ones, before the update. You can see the green flag on the not marked ones on the upper left corner as well.

Thanks

EDIT: Added Bebo's version as a comparision. While yours appear on the left without the zeroes, his version they appear on the right but with the leading zeroes.

And I want them to appear on the left as your snippet but with the leading zeroes as bebo's one

 

[Alex Blakenburg]

Ok try this:
Change the Dim of r from integer to string (or replace whole liine as per the below)

Dim lr&, rng, i&, j&, k&, qpen&, re As String, id As String, arr(1 To 100000, 1 To 13)

Then change the line:

re = arr(k, 5) + 1

To this:

re = Replace(arr(k, 5), Val(arr(k, 5)), Val(arr(k, 5)) + 1)

Possibly not the most efficient way of doing it but I didn't want to assume a certain length or number of zeroes.

 

[jalrs]

Ok try this:
Change the Dim of r from integer to string (or replace whole liine as per the below)

Dim lr&, rng, i&, j&, k&, qpen&, re As String, id As String, arr(1 To 100000, 1 To 13)

Then change the line:

re = arr(k, 5) + 1

To this:

re = Replace(arr(k, 5), Val(arr(k, 5)), Val(arr(k, 5)) + 1)

Possibly not the most efficient way of doing it but I didn't want to assume a certain length or number of zeroes.

Hey Alex,

Thanks for your reply!

Bingo! That did the job!

Thank you so much Alex!

 

[jalrs]

@bebo021999 could you please update your code with @Alex Blakenburg contribution?

Since you did most of the work on solving the issue, I would like to mark yours a solution

Thank you both!

 

[Alex Blakenburg]

You're welcome. Glad we could help.

 

[Alex Blakenburg]

I am 2nd guessing what I gave you previously in terms of being able to not handle the length of the string.
Please add the 2nd line below, the first just being for context.

                                        re = Replace(arr(k, 5), Val(arr(k, 5)), Val(arr(k, 5)) + 1)
                                        re = Right(re, Len(arr(k, 5)))

 

[jalrs]

I am 2nd guessing what I gave you previously in terms of being able to not handle the length of the string.
Please add the 2nd line below, the first just being for context.

                                        re = Replace(arr(k, 5), Val(arr(k, 5)), Val(arr(k, 5)) + 1)
                                        re = Right(re, Len(arr(k, 5)))

Hey @Alex Blakenburg ,

I will test that new line as soon as possible and give feedback about it

Thank you!