Transfer specific columns if a condition is met

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Transfer specific columns if a condition is met & Insert rows at specific points

Post by Doc.AElstein »

_.... following on from the last post

Since a lot of extra stuff crept into that main formatting section, then for tidiness, it might be best to change that section into a With End With Section

Code: Select all

    For Cnt = 34 To ((Segs * 27) + ((Segs - 1) * 7) + 7) Step 34
        With ThisWorkbook.Worksheets("consultant doctor")
       ' Most borders
         .Range("A" & Cnt & "").Offset(-27, 0).Resize(29, 24).Borders.LineStyle = xlContinuous
       ' Sum formulas
         .Range("D" & Cnt + 1 & ":X" & Cnt + 1 & "").Value = "=IF(SUM(R[-28]C:R[-1]C)=0,"""",SUM(R[-28]C:R[-1]C))"
         .Range("D" & Cnt + 7 & ":X" & Cnt + 7 & "").Value = "=R[-6]C"
    '                                                                    First signature                 Second signature                    third signature                 Fourth signature                    Fifth signature
         .Range("A" & Cnt + 2 & ":X" & Cnt + 2 & "").Value = Array("", "First signature", "", "", "", "", "Second signature", "", "", "", "", "Third signature", "", "", "", "", "Fourth signature", "", "", "", "", "Fifth Signature", "", "")
       ' Bold stuff
         .Range("A" & Cnt & "").Offset(1, 0).Resize(7, 24).Font.Bold = True
    
         .Range("A" & Cnt + 1 & "").Value = "The total"
         .Range("A" & Cnt + 7 & "").Value = "Previous total"
       
       ' HPageBreaks.Add
        .HPageBreaks.Add .Range("A" & Cnt + 7 & "")
        End With ' ThisWorkbook.Worksheets("consultant doctor")
    Next Cnt 
The above coding is included in solution here , and in the uploaded file

_.__________________________-


Finally
Some notes, just for future reference to compare what is going on in this Thread and similar other recent thread
This might be useful for future reference to remind of what is going on for future similar requirements…
What is going on is almost identical, and these are the main differences between the final solution here and Hans solution

In Hans solution the data array is pasted out in one go, and then the Range.Sort is done on the pasted out data and then the extra lines are inserted and then the extra lines filled in.

Mine sorts the data in the data array before pasting out and also includes / “inserts” extra empty rows in that data array before pasting out, so that there is no need to insert the extra lines. (Those lines effectively come as extra empty data rows when the data array is pasted out)
The extra lines are filled in a similar way.

I don’t have enough experience yet to know the relative merits of the slightly different approach. I expect the Range.Sort might be something that works better than sorting within the array . I am not sure.
Not having to do the code line to insert lines is probably theoretically a time saver, but since both macros do a lot of filling in of those lines, then that adds so much extra time that that minor time improvement is not noticeable.

An improvement in my macro could be to replace some of the simpler row filling in of for example words, by adding in the data array before pasting out the data array. But once again, since a lot of spreadsheet interaction would still take place in the various formatting, then that improvement would not be noticeable

( As I mentioned previously, my macros can always be improved a bit with the Application.ScreenUpdating = False stuff. I just prefer to leave that out when developing and sharing macros, assuming the OP can easily add that bit themselves )



Alan
You do not have the required permissions to view the files attached to this post.
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

menajaro
2StarLounger
Posts: 182
Joined: 24 Jan 2019, 10:58

Re: Transfer specific columns if a condition is met

Post by menajaro »

Thank you so much my dear friend for Your strong ambition
As a general principle .... The code is your code
You have Three points to complete the code as required
The first point is to add a condition to clear the following pages In case if the data transferred is less than or equal to 27 rows.
in other words, If the data transferred from the Main workbook is less than or equal to 27 rows, the pages that follow first page are deleted
and If the data transferred from the Main workbook is Greater than 27 rows Will be transferred The first 27 rows on the first page And the rest on the second page, and so on ..... Please, note the gray row in both sheets ( consultant doctor & Specialist Doctor )
The second point is to adjust the pages vertical and horizontal page breaks automatically.
The third point is to change the row height for those rows that contains "Total" and "previous total" and the main header in row 7 to 50 points.
After adding these points We can make a comparison Between this and that .... Thank you again for your strong ambition
You do not have the required permissions to view the files attached to this post.

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Transfer specific columns if a condition is met

Post by Doc.AElstein »

Hi menajaro
I think these next couple of offerings will be close to my last here. I don’t see me getting anywhere with those blue Borders, Grey areas etc…) , They are all a total mystery to me. I haven’t got a clue, and don’t have a week spare to get clued up on what they are all about

_.____
So, to answer some last points……
_... As a general principle .... The code is your code
Not really my coding .. all this stuff I picked up from some other more prominent forum helper people , ( like snb , apo) . I am the only one that has come up with any explanation how some of the stuff works , but that’s not important, it seems that most people long since gave up trying to understand anything to do with computers…
That other Thread original first post macro, looks like some aborted attempt at modifying a macro that may have originated from me. You didn’t need … “little modifications ..".. instead, the whole thing was more or less written again by Hans. So he was partly redoing the same as I had done for you previously. That’s not important either.
All your replies suggest
_a) You have difficulty communicating in English
_b) Any attempt by me to explain any answer or suggest how you could do it is pointless, other than for my own future reference. You are only interested in a final working macro.,
Never mind, ….. that’s also all not important..
_.____________________

_(i)....clear the following pages In case if the data transferred is less than or equal to 27 rows.
in other words, If the data transferred from the Main workbook is less than or equal to 27 rows, the pages that follow first page are deleted
and If the data transferred from the Main workbook is Greater than 27 rows Will be transferred The first 27 rows on the first page And the rest on the second page, and so on ..... Please, note the grey row in both sheets ( consultant doctor & Specialist Doctor )……..

As I have I mentioned a few times, Pages and Page Breaks, ( those blue Borders, Grey areas etc…) , are all a total mystery to me. I haven’t got a clue.
I assume you, or someone, have done that manually, in your uploaded file, so running a macro recorder will give you the start which you or I could adapt.
But all my appeals to you to do anything like this yourself have been a total waste of time so far.
I can’t do this all for you. I don’t even know how to do it manually. You probably do, but you aren’t telling…..
_.__________________

_(ii)... adjust the pages vertical and horizontal page breaks automatically… Adjusting the horizontal page breaks automatically is the main thing new in my last version, Solution7. I expect the vertical breaks have some relation to _(i) which I am not clear about.
_._______________

_(iii) …. change the row height for those rows that contains "Total" and "previous total" and the main header in row 7 to 50 points…. I explained a few dozen times to you how to do that and similar things , all to no avail. It is clear you have not taken the slightest interest in anything other than getting a final working macro….
Never mind…..

These code lines put in "Total" and "previous total"
.Range("A" & Cnt + 1 & "").Value = "The total"
.Range("A" & Cnt + 7 & "").Value = "Previous total"

Does that give a clue? Probably not. Never mind. How about
.Range("A" & Cnt + 1 & "").RowHeight = 50
.Range("A" & Cnt + 7 & "").RowHeight = 50

That does work, but possibly this might be more technically correct
.Range("A" & Cnt + 1 & "").EntireRow.RowHeight = 50
.Range("A" & Cnt + 7 & "").EntireRow.RowHeight = 50

Those code lines are within the loop that does all the sections. For the headers a similar code line is needed outside that loop. Something like
ThisWorkbook.Worksheets("Consultant doctor").Rows("7:7").RowHeight = 50
_.___

I will give you another couple of solutions. I doubt I will offer anymore in the near future. I think this thread and others have given you a chance to master all this yourself and easily make any future adaptations or modifications.
But I expect you’ll just look to someone to nigh on re do the same basic stuff over and over again from scratch… Communication with you is some of the problem. Half the time you don’t seem to understand a single word I write.
Never mind :)

So:
Solution 8 has the changes needed for _(iii)

Good luck, if you ever figure out how to do all that _(ii)... blue Borders, Grey areas etc… stuff, then it would be nice of you to post a follow up for the benefit of others…

Alan
_._____

P.S. I did another version, just for completeness, an attempt at a more conventional solution: I took out all the comments , condensed it and added a few minor modifications that I have mentioned previously.
That has obfuscated it enough that I doubt I could figure out myself what’s going on anymore, so it should be close to a more professional solution for you. ( In the workbooks is Solution8b which has some of the development of Soultion9 in it )
( I will also post that solution9 version in the next post. )
You do not have the required permissions to view the files attached to this post.
Last edited by Doc.AElstein on 22 Aug 2020, 09:21, edited 6 times in total.
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Transfer specific columns if a condition is met

Post by Doc.AElstein »

See last post for explanation

Code: Select all

Sub Solution9ProObfuscation()
Application.ScreenUpdating = False
Dim arrK() As Variant:  arrK() = ThisWorkbook.Worksheets("Main workbook").Range("K1:K" & ThisWorkbook.Worksheets("Main workbook").Range("A" & Rows.Count & "").End(xlUp).Row & "").Value
Dim strSuc As String, strSpit As String
 strSuc = "7":  strSpit = "7"
Dim Cnt As Long
    For Cnt = 11 To UBound(arrK(), 1)
        If arrK(Cnt, 1) = "Positive" Then
          strSuc = strSuc & " " & Cnt
        Else
          strSpit = strSpit & " " & Cnt
        End If
    Next Cnt
Dim Clms() As Variant:  Clms() = Array(1, 4, 6, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46)
Dim strRws() As String:  strRws() = Split(strSuc)
Dim strNms() As Variant: strNms() = Application.Index(ThisWorkbook.Worksheets("Main workbook").Cells, strRws(), 6)
Dim rOuter As Long
    For rOuter = 2 To UBound(strNms)
    Dim rInner As Long
        For rInner = rOuter + 1 To UBound(strNms)
            If strNms(rOuter) > strNms(rInner) Then
            Dim varTemp As Variant
              varTemp = strNms(rOuter):  strNms(rOuter) = strNms(rInner):  strNms(rInner) = varTemp
            Dim TempRs As String
              TempRs = strRws(rOuter - 1):  strRws(rOuter - 1) = strRws(rInner - 1):  strRws(rInner - 1) = TempRs
            Else
            End If
        Next rInner
    Next rOuter
 strSuc = Join(strRws(), " ")
Dim Segs As Long:  Segs = Int(((Len(strSuc) - Len(Replace(strSuc, " ", ""))) + 1) / 27) + 1
    For Cnt = 34 To ((Segs * 27) + ((Segs - 1) * 7) + 7) - 34 Step 34
      strSuc = Application.WorksheetFunction.Substitute(strSuc, " ", " 1 1 1 1 1 1 1 ", Cnt - 6)
    Next Cnt
 strSuc = strSuc & "" & Evaluate("=REPT("" 1""," & ((Segs * 27) + ((Segs - 1) * 7) + 7) + 1 - (UBound(Split(strSuc)) + 1) & ")"): strRws() = Split(strSuc)
Dim arrOut() As Variant
  arrOut() = Application.Index(ThisWorkbook.Worksheets("Main workbook").Cells, Application.Index(strRws(), Evaluate("=Row(1:" & UBound(strRws()) + 1 & ")/row(1:" & UBound(strRws()) + 1 & ")"), Evaluate("=Row(1:" & UBound(strRws()) + 1 & ")")), Clms())
    With ThisWorkbook.Worksheets("consultant doctor")
        For Cnt = 34 To ((Segs * 27) + ((Segs - 1) * 7) + 7) Step 34
         arrOut(Cnt + 1 - 6, 1) = "The total": arrOut(Cnt + 7 - 6, 1) = "Previous total"
        Dim Cl As Long
            For Cl = 4 To 24
              arrOut(Cnt + 7 - 6, Cl) = "=R[-6]C": arrOut(Cnt + 1 - 6, Cl) = "=IF(SUM(R[-28]C:R[-1]C)=0,"""",SUM(R[-28]C:R[-1]C))"
            Next Cl
         arrOut(Cnt + 2 - 6, 2) = "First signature": arrOut(Cnt + 2 - 6, 7) = "Second signature": arrOut(Cnt + 2 - 6, 12) = "Third signature": arrOut(Cnt + 2 - 6, 17) = "Forth signature": arrOut(Cnt + 2 - 6, 22) = "Fifth signature"
        .Range("A" & Cnt & "").Offset(-27, 0).Resize(29, 24).Borders.LineStyle = xlContinuous
        .Range("A" & Cnt & "").Offset(1, 0).Resize(7, 24).Font.Bold = True
        .Range("A" & Cnt + 1 & "").EntireRow.RowHeight = 50: .Range("A" & Cnt + 7 & "").EntireRow.RowHeight = 50
        .HPageBreaks.Add .Range("A" & Cnt + 7 & "")
        Next Cnt
    .Range("A7").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2)) = arrOut()
        With .UsedRange
        .Font.Name = "Times New Roman"
        .Font.Size = 13
        .Columns("D:X").NumberFormat = "0.00"
        .EntireColumn.AutoFit
        End With
    .Rows("7:7").RowHeight = 50
    .Rows(((Segs * 27) + ((Segs - 1) * 7) + 7) + 7).Delete
    End With
  strRws() = Split(strSpit)
  strNms() = Application.Index(ThisWorkbook.Worksheets("Main workbook").Cells, strRws(), 6)
    For rOuter = 2 To UBound(strNms)
        For rInner = rOuter + 1 To UBound(strNms)
            If strNms(rOuter) > strNms(rInner) Then
              varTemp = strNms(rOuter):  strNms(rOuter) = strNms(rInner):  strNms(rInner) = varTemp
              TempRs = strRws(rOuter - 1):  strRws(rOuter - 1) = strRws(rInner - 1):  strRws(rInner - 1) = TempRs
            Else
            End If
        Next rInner
    Next rOuter
  strSpit = Join(strRws(), " ")
  Segs = Int(((Len(strSpit) - Len(Replace(strSpit, " ", ""))) + 1) / 27) + 1
    For Cnt = 34 To ((Segs * 27) + ((Segs - 1) * 7) + 7) - 34 Step 34
      strSpit = Application.WorksheetFunction.Substitute(strSpit, " ", " 1 1 1 1 1 1 1 ", Cnt - 6)
    Next Cnt
  strRws() = Split(strSpit)
  strSpit = strSpit & "" & Evaluate("=REPT("" 1""," & ((Segs * 27) + ((Segs - 1) * 7) + 7) + 1 - (UBound(strRws()) + 1) & ")")
  strRws() = Split(strSpit)
  arrOut() = Application.Index(ThisWorkbook.Worksheets("Main workbook").Cells, Application.Index(strRws(), Evaluate("=Row(1:" & UBound(strRws()) + 1 & ")/row(1:" & UBound(strRws()) + 1 & ")"), Evaluate("=Row(1:" & UBound(strRws()) + 1 & ")")), Clms())
    With ThisWorkbook.Worksheets("Specialist Doctor")
        For Cnt = 34 To ((Segs * 27) + ((Segs - 1) * 7) + 7) Step 34
          arrOut(Cnt + 1 - 6, 1) = "The total": arrOut(Cnt + 7 - 6, 1) = "Previous total"
            For Cl = 4 To 24
             arrOut(Cnt + 7 - 6, Cl) = "=R[-6]C": arrOut(Cnt + 1 - 6, Cl) = "=IF(SUM(R[-28]C:R[-1]C)=0,"""",SUM(R[-28]C:R[-1]C))"
            Next Cl
          arrOut(Cnt + 2 - 6, 2) = "First signature": arrOut(Cnt + 2 - 6, 7) = "Second signature": arrOut(Cnt + 2 - 6, 12) = "Third signature": arrOut(Cnt + 2 - 6, 17) = "Forth signature": arrOut(Cnt + 2 - 6, 22) = "Fifth signature"
        .Range("A" & Cnt & "").Offset(-27, 0).Resize(29, 24).Borders.LineStyle = xlContinuous
        .Range("A" & Cnt & "").Offset(1, 0).Resize(7, 24).Font.Bold = True
        .Range("A" & Cnt + 1 & "").EntireRow.RowHeight = 50: .Range("A" & Cnt + 7 & "").EntireRow.RowHeight = 50
        .HPageBreaks.Add .Range("A" & Cnt + 7 & "")
        Next Cnt
    .Range("A7").Resize(UBound(arrOut(), 1), UBound(arrOut(), 2)) = arrOut()
        With .UsedRange
        .Font.Name = "Times New Roman"
        .Font.Size = 13
        .Columns("D:X").NumberFormat = "0.00"
        .EntireColumn.AutoFit
        End With
    .Rows("7:7").RowHeight = 50
    .Rows(((Segs * 27) + ((Segs - 1) * 7) + 7) + 7).Delete
    End With
Application.ScreenUpdating = True
End Sub
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

menajaro
2StarLounger
Posts: 182
Joined: 24 Jan 2019, 10:58

Re: Transfer specific columns if a condition is met

Post by menajaro »

Thank you so much Alan, You are a true legend.
generally this will be the best as you who offered it
Now Everything works fine except one point ... i'll try my best to illustrate this point Later
Thank you for taking time and helping me to find a solution.
Best Regards
You do not have the required permissions to view the files attached to this post.
Last edited by menajaro on 17 Aug 2020, 18:47, edited 1 time in total.

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Transfer specific columns if a condition is met

Post by Doc.AElstein »

Sorry, I don’t understand anything you said in your last post.
The code snippets you showed and the uploaded file contain some mutation abortion with no indication or understandable explanation of what you have attempted to do.
I don’t think there’s any point in me contributing much more in this thread. You can’t communicate in English.
Sorry
Good luck


Edit: I see you have gone back and done some major edits making the following posts and this one read a bit stupid. That is very bad posting practice. This will further increase the confusion that your lack of communiction skill in English has caused..
Last edited by Doc.AElstein on 22 Aug 2020, 09:27, edited 2 times in total.
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

menajaro
2StarLounger
Posts: 182
Joined: 24 Jan 2019, 10:58

Re: Transfer specific columns if a condition is met

Post by menajaro »

menajaro wrote:
12 Aug 2020, 00:45
The first point is to add a condition to clear the following pages In case if the data transferred is less than or equal to 27 rows.
in other words, If the data transferred from the Main workbook is less than or equal to 27 rows, the pages that follow first page are deleted
and If the data transferred from the Main workbook is Greater than 27 rows Will be transferred The first 27 rows on the first page And the rest on the second page, and so on
Thank you anyway and I am learning a lot from all of you.

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Transfer specific columns if a condition is met

Post by Doc.AElstein »

Good luck.
I think you should make some effort to improve your English if you intend to continue to ask for help in an English speaking forums, since otherwise you take up 10 - 100 times as much of helpers time as necessary, and in many cases totally waste their time.

I think the way you are going about all this is the totally wrong and inefficient way, but all my attempts to explain have been lost in the communication difficulty

( By the way, - it is very bad posting practice to make major edits to a post after someone has answered, as you did, since this may make some of the following posts appear out of sync or inappropriate)


Alan
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Transfer specific columns if a condition is met

Post by Doc.AElstein »

This post is partly for my future and other future Thread references, mainly as some others are clearly drawing on stuff from this thread, and I don’t like leaving things hanging in an incomplete mess…

Mainly this was the last point annoying me a lot….
_A_ Pages breaks / Borders etc..
Doc.AElstein wrote:
16 Aug 2020, 11:38
.... Pages and Page Breaks, ( those blue Borders, Grey areas etc…) , are all a total mystery to me...
Some other mutations of the coding I saw appearing lead me to look at printing related stuff…. that lead me on to .....
In the View Ribbon we can see the “Page Break Preview” , and on selecting that those blue Borders, Grey areas appear: https://imgur.com/ekPbjMF
PageBreakPreview__.jpg
If we run the macro recorder whilst selecting “Page Break Preview” then we get this code line
ActiveWindow.View = xlPageBreakPreview
Putting that code line into the solution versions give an output more similar to the average of what the OP has been asking for.
In the enclosed file, Solution10.xlsm, the macro Sub Solution10_A_ProObfuscation() includes these simple code lines

So that goes someway to explaining that big mystery. I expect that possibly dragging some of the blue Borders, around whilst running the macro recorder may help get to an exact correlation with the desired results.

_.__________________
A few other things whilst I am here…
_B)_ Sorting, Not
I have seen an attempt to remove the sorting, possibly because in larger files, my array sorting may not have been the best way.
Sub Solution10_B_ProObfuscation() simply removes the sorting: The sorting is not done
The simple modification is to remove these sections:

Code: Select all

        strRws() = Split(strSpit)
  strNms() = Application.Index(ThisWorkbook.Worksheets("Main workbook").Cells, strRws(), 6)
    For rOuter = 2 To UBound(strNms)
        For rInner = rOuter + 1 To UBound(strNms)
            If strNms(rOuter) > strNms(rInner) Then
              varTemp = strNms(rOuter):  strNms(rOuter) = strNms(rInner):  strNms(rInner) = varTemp
              TempRs = strRws(rOuter - 1):  strRws(rOuter - 1) = strRws(rInner - 1):  strRws(rInner - 1) = TempRs
            Else
            End If
        Next rInner
    Next rOuter
  strSpit = Join(strRws(), " ")
( That code section example above is doing an array bubble sort. There are two parallel 1 dimensional arrays, the array holding the current row indicia, strRws() , and an array holding the names by which the sorting is required. The names array is the array subject to the Bubble sort, and at the point that elements of that array are exchanged, we also at that point exchange the corresponding row indicia element )
_.________


_C_ Conventional Range.Sort alternative
( The macro solutions in this Thread, generally are so very inefficient due to all the repeated worksheet pasting, that I doubt the difference in different sorting methods is very relevant. But for completeness, this macro version, Sub Solution10_C_ProObfuscation , uses the more usual Range.Sort )
In this implementation, the previous two arrays are pasted out into two side by side columns, the Range.Sort is applied on that range using the names columns as the Key1, and the sorted column for the row indicia is put back into strRws ( note** strRws not strRws() )
( I use arbitrarily column ranges in the worksheets that would be overwritten finally )
This is one of the equivalent sections

Code: Select all

  strRws = Split(strSpit)
  strNms() = Application.Index(ThisWorkbook.Worksheets("Main workbook").Cells, strRws, 6)
     With ThisWorkbook.Worksheets("Specialist Doctor")
      .Range("B7:B" & UBound(strNms()) + 7).Value2 = Application.Index(strNms(), Evaluate("=Row(1:" & UBound(strNms()) + 1 & ")/row(1:" & UBound(strNms()) + 1 & ")"), Evaluate("=Row(1:" & UBound(strNms()) + 1 & ")"))
      .Range("A7:A" & UBound(strRws) + 7).Value2 = Application.Index(strRws, Evaluate("=Row(1:" & UBound(strRws) + 1 & ")/row(1:" & UBound(strRws) + 1 & ")"), Evaluate("=Row(1:" & UBound(strRws) + 1 & ")"))
      .Range("A7:B" & UBound(strRws) + 7).Sort Key1:=.Range("B2"), Header:=True
      strRws = Application.Index(.Range("A7:A" & UBound(strRws) + 7).Value2, Evaluate("=Column(A:" & CLtr(UBound(strRws) + 1) & ")"), Evaluate("=Column(A:" & CLtr(UBound(strRws) + 1) & ")/Column(A:" & CLtr(UBound(strRws) + 1) & ")"))
     End With
  strSpit = Join(strRws, " ") 
( ** note that for this version strRws is now declared as Variant as a means to allow it to be an array of either
_String type, as given from the Split
_ Variant type as given by the Index )
_._________

The three new solutions, _A _B and _C in the attached file are all in the condensed “professional obfuscation” forms.


Alan
You do not have the required permissions to view the files attached to this post.
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

menajaro
2StarLounger
Posts: 182
Joined: 24 Jan 2019, 10:58

Re: Transfer specific columns if a condition is met

Post by menajaro »

Once again many many thanks for your effort!
This topic will help you In exploring the last point that must be achieved.
https://eileenslounge.com/viewtopic.php?f=30&t=35200
current example contains four pages in the consultant doctor sheet And three pages in the Specialist Doctor sheet.
Please return to the Main workbook sheet, Then delete the rows from row number 62 until the last row, Then run the code to see what I mean.
After running the code, Each sheet should contain On one page ... You will notice that the following pages are not deleted.
My question now is: how can Delete the following pages In the case if the data That has been transferred Less than or equal to 27 rows.
My apologies for my bad language ... With my best wishes of good and great luck for you forever.

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Transfer specific columns if a condition is met

Post by Doc.AElstein »

Hi
menajaro wrote:
24 Aug 2020, 02:21
...delete the rows from row number 62 until the last row, Then run the code to see what I mean.
If I delete from rows 62 in the main worksheet , then I do not get the “empty pages” that you are referring to.

If I delete from rows 62 in the main worksheet and run any of my last three macros, I get .._
_.. this in Consult Doctor, showing two pages : https://imgur.com/tvISHOd
_.. and this in Specialist Doctor, showing one page : https://imgur.com/KhRfAGy

Lets now examine this situation , for understanding purposes...
In this situation , if we
hit Alt+11 to get in the VB Editor,
click anywhere in one of the macros, and
run the macro from the VB Editor in the so called "step/Debug mode" ( Key F8 ) , and
stop the macro at various points in its execution, then
hit Ctrl+g to get in the immediate window and then
type in the immediate window the following, ( followed by hitting Enter key )
? ((Segs * 27) + ((Segs - 1) * 7) + 7)-34
or
? ((Segs * 27) + ((Segs - 1) * 7) + 7)
then we get_...
_ for worksheet "consultant doctor" 34 and 68 : https://imgur.com/ECGOHoQ
Similarly we can examine those similar code parts forthe other worksheet
_ for worksheet “Specialist Doctor” we get 0 and 34 : https://imgur.com/0TgoQ2v

We could also hover over Segs with the mouse, and then see for
_ worksheet "consultant doctor" it is 2 : https://imgur.com/2oiHBvE
_ worksheet “Specialist doctor” it is 1 : https://imgur.com/yl8WE0f

That is all telling us that we will get
two sections for consultant doctor ( Loop for 34 to 68 step 34 ) with one of the in betweeen 7 row sections ( loop 34 to 34 step 34 )
and
one section for specialist doctor ( loop 34 to 34 step 34 ) without any of the in betweeen 7 row sections ( loop 34 to 0 step 34 ( meaning that part will not be done, so no in betweeen 7 row sections ) ).
So far all is well….

But….
Problem 1
If I delete from rows 60, I can reproduce the problem that you may be referring to: I get this in consult doctor : https://imgur.com/h7aWyEg

The problem seems to be the Segs calculation.
Going right back to my first solution, where the codings were not so obfuscated, we determined the number of sections, Segs , as
= ( Integer of ( total rows / 27 ) ) + 1

This is possibly not quite correct… One problem is, for example: If we have 27 rows of data, then we would actually have 28 rows in the indicia string, since we include the first header row.
I think we should be doing the calculation of = ( Integer of ( (total rows-1) / 27 ) ) + 1
( Alternatively, the total rows used in the original calculation needs to be reduced by 1)
That removes the error introduced by having an extra header row which we don’t want when considering the number of data rows,
But further….. there is a second problem..
Problem 2
In fact, with problem 1 solved, we are still not quite correct, there remains one major error in my original thinking. For exact multiples of 27, the original formula will continue to give the wrong results. Even if we did not have an extra header row, the correct formula should be
Segs , as
= ( Integer of (( total rows -1) / 27 ) ) + 1
So we need to have another -1 correction

In the last few macro versions, the correction to be made is to change this
Segs = Int(((Len(strSpit) - Len(Replace(strSpit, " ", ""))) + 1) / 27) + 1
to this
Segs = Int(((Len(strSpit) - Len(Replace(strSpit, " ", ""))) + 1 - 1 - 1) / 27) + 1
or this
Segs = Int(((Len(strSpit) - Len(Replace(strSpit, " ", ""))) - 1) / 27) + 1

I have made those corrections in the uploaded file, Solution11.xlsm , for the macros
Sub Solution11_A_ProObfuscation()
Sub Solution11_B_ProObfuscation()
Sub Solution11_C_ProObfuscation()


At first glance, that appears to solve the problem, but I leave it to you to check thoroughly.
( The second problem is a very typical mistake often made when making such segmentation calculations. It demonstrates that in such work typical test data should be chosen carefully to check all typical scenarious including what happens at such "border" type cases. Such subtle mistakes often go un noticed for a long time in the practice... ( Modern practice seems to be to hide someones embarresment in making such a stupid mistake like this within an "Update" issue.... ) )

Alan

_.__
P.S:- Some confusion arises / has arisen, due to you asking the wrong question, which arises
_a) because of language communication problem
and
_b) not having understood what the coding is doing
_...
the question/issue is not...how to Delete the following pages In the case if the data That has been transferred Less than or equal to 27 rows.....
_.. the question/issue is not to do with deleting anything.... the question/issue concerns a problem resulting in something being produced that should not have been produced...
The solution involves_..
_ doing it properly so that only what you want is always produced and not sometimes stupidly having some unwanted stuff produced
You do not have the required permissions to view the files attached to this post.
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also