Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 23

Thread: Moving different rows data to one row based on criteria to optimise on printing

  1. #1
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    231
    Location

    Moving different rows data to one row based on criteria to optimise on printing

    Hi ,

    I need help on how we can automate this task through VBA as actually we are doing this manually and is very time consuming and many errors also are being made.

    Thank in advance for any tips and guidance.

    We have actually a visual planning which we have already generated through many calculations (was possible also with the forum help to automate it).

    Refer to the attached file on sheet Actual_Visual_Planning. This result is obtain after all the calculation is done and is generated with the help of VBA as the initial calculation are not as such.

    The visual planning are printed and given to all department to follow on which date what order is starting and also on which line number, etc.

    The problem when we are printing for info the planning itself is with almost 1000 rows with 26 line of production and almost 8 -25 orders plan per production line.) this is taking a lot of pages like almost 20-25 pages sometime even more.

    We have come up with a solution where we are copy and pasting the planned orders from the below row for the first row of the same Line Number and deleting all the orders plan below thus keeping only the data pasted in the single row.

    Refer to the sheet Exp_Visual_Planning to have a better idea of what we are doing actually manually.

    When pasting we are just moving the planned data same as the date it starting thus keeping them in the same column as it was initially on sheet Actual_Visual_Planning.

    And same apply when the line number changes, we will paste to the first row of the concern line number.

    So its just like moving up the planned data for sheet Actual_Visual_Planning up on the same column but on the first row for each production line.

    This is taking a considerably amount of time for doing it as its being done manually and we have to copy paste for all the 26 lines like that taking into consideration different orders we have and also the risk of mistake we are making.

    By so doing we have been able to print the visual plan in almost 6-8 pages instead of 20-25 pages.

    I will be much grateful if I can get some guidance and tips on how I can automate the copy, paste and delete the below lines through vba please.

    Attached Files Attached Files

  2. #2
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    479
    Location
    Hi VISHAL120!
    Line Name B has overlapping parts.
    Between ROW(29:30) and ROW(32:33), column CX.


    --Okami

  3. #3
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    479
    Location
    If has no overlapping parts:
    Sub test()
    Dim r&, rng As Range, i&, cCnt&, rngBlk As Range
    For i = 11 To Cells(Rows.Count, 1).End(3).Row Step 3
      If Cells(i, 1) <> Cells(i - 2, 1) Then
        r = i
      Else
        Set rng = Cells(i, 213).End(1)
        If rng.MergeCells Then cCnt = rng.MergeArea.Columns.Count Else cCnt = 1
        c = rng.Column
        rng.Resize(2, cCnt).Copy Cells(r, c)
        If rngBlk Is Nothing Then Set rngBlk = Rows(i).Resize(3) Else Set rngBlk = Union(rngBlk, Rows(i).Resize(3))
      End If
    Next i
    rngBlk.Delete
    End Sub

  4. #4
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    231
    Location
    Hi ,

    thanks for your kind help and support.
    for the overlapping parts we just move it to the next free columns otherwise we just move it upwards and also as you see on the sheet Exp_Visual_Planning we place the borders manually so that it's easy to identify the orders in between.

    I have testes the code i work well when there is no overlapping as you said. thank you a lot but can you just see to it for the borders in between the orders that are moving up and also in case there are over lapping to just move it to the next free column.

    thanks you again for your kind support an quick help sir.

  5. #5
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    479
    Location
    Hi VISHAL120!
    Sub test()
    Dim r&, rng As Range, i&, cCnt&, rngBlk As Range
    Application.ScreenUpdating = False
    For i = 11 To Cells(Rows.Count, 1).End(3).Row Step 3
      If Cells(i, 1) <> Cells(i - 2, 1) Then
        r = i
      Else
        Set rng = Cells(i, 213).End(1)
        If rng.MergeCells Then cCnt = rng.MergeArea.Columns.Count Else cCnt = 1
        c = rng.Column
        Do While Cells(r, c).MergeCells
          c = c + 1
        Loop
        rng.Resize(2, cCnt).Copy Cells(r, c)
        If rngBlk Is Nothing Then Set rngBlk = Rows(i).Resize(3) Else Set rngBlk = Union(rngBlk, Rows(i).Resize(3))
      End If
    Next i
    rngBlk.Delete
    Application.ScreenUpdating = True
    End Sub

  6. #6
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    231
    Location

    Moving different rows data to one row based on criteria to optimise on printing

    Hi Okami,

    thank you so much works very well with the overlapping. can you please for a last one advise how we can place the borders same as the below example file attached.

    thanks again for the kind help and time.
    Attached Files Attached Files

  7. #7
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    479
    Location
    like below:
    Sub test001()
    Dim r&, rng As Range, i&, cCnt&, rngBlk As Range
    Application.ScreenUpdating = False
    For i = 11 To Cells(Rows.Count, 1).End(3).Row Step 3
      If Cells(i, 1) <> Cells(i - 2, 1) Then
        r = i
        If Cells(i, 83).MergeCells Then cCnt = Cells(i, 83).MergeArea.Columns.Count Else cCnt = 1
        Call Bord(r, 83, cCnt)
      Else
        Set rng = Cells(i, 213).End(1)
        If rng.MergeCells Then cCnt = rng.MergeArea.Columns.Count Else cCnt = 1
        c = rng.Column
        Do While Cells(r, c).MergeCells
          c = c + 1
        Loop
        rng.Resize(2, cCnt).Copy Cells(r, c)
        Call Bord(r, c, cCnt)
        If rngBlk Is Nothing Then Set rngBlk = Rows(i).Resize(3) Else Set rngBlk = Union(rngBlk, Rows(i).Resize(3))
      End If
    Next i
    rngBlk.Delete
    Application.ScreenUpdating = True
    End Sub
    
    Sub Bord(r, c, cCnt)
    Dim i&
    For i = 7 To 10
      With Cells(r, c).Resize(2, cCnt).Borders(i)
        .LineStyle = xlContinuous
        .Weight = xlMedium
      End With
    Next i
    End Sub

  8. #8
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    231
    Location
    Hi Okami,

    thanks you a lot, yes same as such.

    fantastic you made my day sir.

  9. #9
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    479
    Location
    Hi VISHAL120!
    You're welcome
    In fact, it's best to process data when it's generated.

  10. #10
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    231
    Location
    Hi Okami,

    Thank you for the suggestion, indeed we wanted to do that but the code already when generating the visual plan is taking almost 25 secs + for that so that is why we break it in 2 parts .

  11. #11
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    479
    Location
    Hi VISHAL120!
    Can you post the whole file here(with little data), Maybe I can make better suggestions.

  12. #12
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    231
    Location
    Hi Okami,

    sure and thanks for the kind help. let me remove some data from it and also seperate it from the main file and i will send it during the day.

  13. #13
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    231
    Location

    Moving different rows data to one row based on criteria to optimise on printing

    Hi okami,

    As requested here attached the file with part of the data. I am just sending the part which is concern with the visual planning report .

    1. You will see on the file there are 5 sheets( some of the sheets has been added just for your info.
      1. Sheet Customer_Color_Codes is where the customer colors are keep so as to place the color as per the customer color we have define.
      2. Sheet Master_Visual is where we will have the data to start generating the visual planning report. This data is obtain from calculation which are done before.
      3. Sheet VISUAL DISPLAY REPORT is the report which have already been generated.
      4. Sheet LINEAR VISUAL PLAN this is the part that you have help me to be able to show the user the orders plan in one line and improve for the printing.

    2. You will see I have place the code on buttons that I have place on the master_Visual.



    The steps I am proceeding actually are as follows:
    For better understanding please do run as explain below then you will see exactly the process.


    1. Click on the button populate lines.
    2. After it has duplicate the lines I need to add Number 1 at the end on the column G. this is because to keep the last row in odd number to help for line insertion in between the order reference which were duplicated otherwise it will insert line in between the order reference itself. Sheet Visual Planning format error shows how the error will be if the Number 1 is not place.
    3. <<This one takes almost 57 secs to process.>>
    4. Click on button Build Visual Display Report this will generate the visual same as sheet VISUAL DISPLAY REPORT. <<This one takes almost 25 secs to process.>>
    5. After the Visual display report has been generated then click on the button Linear Visual Plan to have the last final results same as Sheet LINEAR VISUAL PLAN (the one that you have help). <<This one takes nearly 8-10 secs to process.>>


    Thank you in advance if you can guide on speeding this part. Just to inform all these were done manual to get the final results which were taking days to do with all the mistakes and involving 2 people. Today we have been able to do it in let say may be 5 mins compare to days.
    If I can still improve it then it good enough.
    Attached Files Attached Files

  14. #14
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    479
    Location
    Hi VISHAL120!
    Please refer to the attachment. Maybe a little faster.
    Attached Files Attached Files

  15. #15
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    231
    Location
    Hi Okami,
    thank you very much i have try to go through the codes but found it very complex but still its quite faster compare to the previous code.

    i will try to compile the code on the main planning and see what it give as result on the speed, am sure it will be very much better than the previous one.

    once i finish i will revert back to you. thanks again for the kind help.

  16. #16
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    231
    Location

    Moving different rows data to one row based on criteria to optimise on printing

    Hi Okami,
    I have tested the code you have done it works very well and very quick too but i dont know why all of a sudden am having error to generate the report. Am attaching the file below for your understanding.
    i have even run it with the break F8 and still could find the mistake if you can just give some idea on it.
    Attached Files Attached Files

  17. #17
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    479
    Location
    Hi VISHAL120!
    The reason for the error is that there is no customer color of "ORC-AC" in sheets ("Customer_Color_Codes").
    You can also set a "other" color, which is used for all items that do not exist in the list, Of course I need to modify the code.
    Attached Files Attached Files

  18. #18
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    231
    Location

    Moving different rows data to one row based on criteria to optimise on printing

    Hi Okami,

    thanks for the clarification and help.
    one last help brother.
    for the T-A-O-OF-VA-L or T-A-O-OF-N-L

    which is done by this code :

    If Left(.Value, 1) = "T" Then .Characters(Start:=1, Length:=1).Font.Color = IIf(arr(rw, 12) = "", -16776961, -11489280) ' T  'Use your method intact, only change worksheet function into vba.
            If Mid(.Value, 3, 1) = "A" Then .Characters(Start:=3, Length:=1).Font.Color = IIf(arr(rw, 10) = "", -16776961, -11489280) ' A
            If Mid(.Value, 5, 1) = "O" Then .Characters(Start:=5, Length:=1).Font.Color = IIf(arr(rw, 19) = "", -16776961, -11489280) 'O
            If Mid(.Value, 7, 2) = "OF" Then .Characters(Start:=7, Length:=2).Font.Color = IIf(arr(rw, 25) = "", -16776961, -11489280) 'OF
            If Mid(.Value, 9, 2) = "VA" Or Mid(.Value, 9, 1) = "N" Then .Characters(Start:=9, Length:=2).Font.Color = IIf(arr(rw, 19) = "", -16776961, -11489280)   'O
            If Mid(.Value, 11, 1) = "L" Then .Characters(Start:=9, Length:=2).Font.Color = IIf(arr(rw, 19) = "", -16776961, -11489280)  'O
    I have added some code more so that but if you will run the code you will see the VA and L are not changing color based on the condition that are set for
    If Mid(.Value, 5, 1) = "O" Then .Characters(Start:=5, Length:=1).Font.Color = IIf(arr(rw, 19) = "", -16776961, -11489280) 'O
    can you please help on this part please i have tried many times it remain the same it don't change the color on this part. which means if the O is red the VA and the L also shall be Red else Green.

    And also on this part of the code where it takes the interior color of the cells:
    For Each c In dTmp.keys
        r = r + 3
        arr1 = Split(dTmp(c), "+")
        .Cells(r, 1).Resize(2, 2) = Split(c, ",")
        .Cells(r, 1).Resize(2, 2).Interior.Color = arr1(0)
        For i = 1 To UBound(arr1) Step 6
    It shall also change the font color accordingly as it changes only the interior color and leaving the font color black for which in some lines the font is not visible where its darker. see row 15-16 . 18-19 for example the font for the lines number and name shall have been white.

    Thank you in advance.
    Attached Files Attached Files
    Last edited by VISHAL120; 05-15-2019 at 01:11 AM.

  19. #19
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    479
    Location
    because of Mid(.Value, 9, 2)="-", so you can change 9 into 10 and try it again.

  20. #20
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    231
    Location
    Hi Okami,

    I have finally figured the part for the T-A-O-OF-VA-L or T-A-O-OF-N-L color change which are as below:
    If Left(.Value, 1) = "T" Then .Characters(Start:=1, Length:=1).Font.Color = IIf(arr(rw, 12) = "", -16776961, -11489280) ' T  'Use your method intact, only change worksheet function into vba.
            If Mid(.Value, 3, 1) = "A" Then .Characters(Start:=3, Length:=1).Font.Color = IIf(arr(rw, 10) = "", -16776961, -11489280) ' A
            If Mid(.Value, 5, 1) = "O" Then .Characters(Start:=5, Length:=1).Font.Color = IIf(arr(rw, 19) = "", -16776961, -11489280) 'O
            If Mid(.Value, 7, 2) = "OF" Then .Characters(Start:=7, Length:=2).Font.Color = IIf(arr(rw, 25) = "", -16776961, -11489280) 'OF
            If Mid(.Value, 10, 2) = "VA" Then .Characters(Start:=10, Length:=2).Font.Color = IIf(arr(rw, 19) = "", -16776961, -11489280)   'O
            If Mid(.Value, 10, 1) = "N" Then .Characters(Start:=10, Length:=2).Font.Color = IIf(arr(rw, 19) = "", -16776961, -11489280)   'O
            If Mid(.Value, 13, 1) = "L" Then .Characters(Start:=13, Length:=2).Font.Color = IIf(arr(rw, 19) = "", -16776961, -11489280)  'O
            If Mid(.Value, 12, 1) = "L" Then .Characters(Start:=12, Length:=2).Font.Color = IIf(arr(rw, 19) = "", -16776961, -11489280)  'O
            If Mid(.Value, 13, 1) = "N" Then .Characters(Start:=13, Length:=2).Font.Color = IIf(arr(rw, 19) = "", -16776961, -11489280)  'O
            If Mid(.Value, 12, 1) = "N" Then .Characters(Start:=12, Length:=2).Font.Color = IIf(arr(rw, 19) = "", -16776961, -11489280)  'O
    can you guide me on the part below please:

    And also on this part of the code where it takes the interior color of the cells:
     	For Each c In dTmp.keys
        r = r + 3
        arr1 = Split(dTmp(c), "+")
        .Cells(r, 1).Resize(2, 2) = Split(c, ",")
        .Cells(r, 1).Resize(2, 2).Interior.Color = arr1(0)
        For i = 1 To UBound(arr1) Step 6
    It shall also change the font color accordingly as it changes only the interior color and leaving the font color black for which in some lines the font is not visible where its darker. see row 15-16 . 18-19 for example the font for the lines number and name shall have been white.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •