• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Split multiple columns based on range

Dear Sir,

I misunderstand your concept.
Working perfectly as per my requirement.
Infinitive thank you very much. You have made my job extremely easy.

Once again thank you very much. It also working with dynamic range.
 
What a great news : I did not waste my time !
If it's a concept, it's just the easy Excel one, an easy logic …

I can't understand why you create a vertical way
as you need the results in a horizontal way,
the easy way is to create data in the same format in order to start from
a smart worksheet so far easier to expect for a smart code …

The parameters worksheet (#1) is now more readable than your original !
As my procedure works, you can rename both worksheets as you like,
for example Parameters & Template, whatever
as the procedure does not use their names …
 
Dear Sir,

Definatly is now very simple for me to set output.

Thank you very much for your effort.

I really appreciate your concept and code.

Once again thank you very much.
 
Last edited:

This can be a little optimized if the right part has always same format
than the left part so the Template worksheet (#2) just needs cells A1:F4
as actually if you need to change any formatting
you need to apply it to both ranges (A1:F4 & H1:M4) …
 
Edit : in fact it can't be optimized the way I was thinking
'cause of columns width & rows height so the easy way is to stay like it is …

If you need to change a formatting in Template worksheet (#2)
in the left part, if the right part is the same you must report the change too …
 

But I need your new workbook with only the two new worksheets
'cause in case of any change in the template sheet (#2) and
if the result sheets (G1, G2, …) already exist the actual code
may not well report this change (ex: column width / row height) …
 
Dear Sir,

Very good morning.

After running macro output format is getting change.
Please find workbook containing three sheet.
Sheet1 - "Data" entry sheet
sheet2 - "template"
sheet3 - "output" How actual output looks.

I have also included original macro.

Thanking you in advance.
 

Attachments

  • Trial Updated 10_07_18.xlsm
    29.7 KB · Views: 3
Typos in your source worksheet Data : edit cells A11 & A16 …

I have to apply a workaround then
it can only have a single model in the worksheet Template
if the right part formatting is always the same as the left part ?
 
Dear Sir,

Please find corrected sheet.
yes, right and left part is always having same formatting. Column width is changing.
 

Attachments

  • Trial Updated 10_07_18.xlsm
    29.8 KB · Views: 7
If possible right and left formatting make dynamic if required later. So, in future no further modification is require.

If you want two create two entry sheet and two template and one output. I will modified entry sheet.
 
So only one model for each part then
in worksheet Template you can delete columns H to M …​
Code:
Sub Demo2()
    Dim Rg As Range, V, M%
    Set Rg = Sheet1.[A1]
    Application.ScreenUpdating = False
  While Rg.Value > ""
    V = Evaluate(Replace("IF(COLUMN(#)>1,#*5,#)", "#", Rg.Resize(, 3).Address(External:=True)))
    M = Application.Max(V)
    If Evaluate("ISREF('" & V(1) & "'!A1)") Then Worksheets(V(1)).UsedRange.Clear Else Sheets.Add(, Sheets(Sheets.Count)).Name = V(1)
        With Worksheets(V(1))
                Sheet2.Rows("1:5").Copy .Rows("1:" & M)
                Sheet2.Columns("A:G").Copy .Columns("A:G")
            If V(3) > 0 Then
                Sheet2.Columns("A:F").Copy .Columns("H:M")
               .[H1:M4].Value = Rg(1, 12).Resize(4, 6).Value
                If V(3) > 5 Then .[H1:M5].Copy .Range("H6:M" & V(3))
            End If
            If V(2) > 0 Then
               .[A1:F4].Value = Rg(1, 5).Resize(4, 6).Value
                If V(2) > 5 Then .[A1:F5].Copy .Range("A6:F" & V(2))
            Else
               .[A1:F4].Clear
            End If
        End With
    Set Rg = Rg.End(xlDown)
  Wend
    Set Rg = Nothing
    Application.ScreenUpdating = True
End Sub
You may Like it !
 
Back
Top