Formula to allocate name and count in col 'F'.

Hi Forum team,

I have just working on worksheet i need formula to Drag Allocation in DATA file Cp and Qty wise in col 'F' and insert Blank row after Cp name in col F.

I have attached sample data file. any help Greatly appriciate.

Thanks in advance.

Based on your data size it is better to go for VBA solution.

Please confirm whether VBA solution is ok for you?

Originally Posted by :) Sixthsense :)

Based on your data size it is better to go for VBA solution.

Please confirm whether VBA solution is ok for you?

Hi,Sixthsense

Ok no problem .

Try the below code….


How to install your new code

1. Copy the Excel VBA code
2. Select the workbook in which you want to store the Excel VBA code
3. Press Alt+F11 to open the Visual Basic Editor
4. Choose Insert > Module
5. Edit > Paste the macro into the module that appeared
6. Close the VBEditor
7. Save your workbook (Excel 2007+ select a macro-enabled file format, like *.xlsm)

To run the Excel VBA code:

1. Press Alt-F8 to open the macro list
2. Select a macro in the list
3. Click the Run button

Sub ArrangeData()
Dim rData As Range, rAllocation As Range, lRw As Long, lCopy As Long, lStart As Long

With Sheets("DATA")
    lRw = .Cells(Rows.Count, "A").End(xlUp).Row
    Set rData = .Range("A1:H" & lRw)
End With

With Sheets("ALLOCATION")
    lRw = .Cells(Rows.Count, "A").End(xlUp).Row
    Set rAllocation = .Range("A1:C" & lRw)
End With

Application.ScreenUpdating = False

Sheets.Add , Sheets(rAllocation.Parent.Name)

For i = 2 To lRw
    If i = 2 Then lStart = 1
    lCopy = rAllocation.Columns(3).Cells(i).Value
    rData.Rows(lStart).Resize(lCopy).Copy Cells(Rows.Count, "A").End(xlUp)(3)
    Cells(lStart + (i), "F").Resize(lCopy).Value = rAllocation.Columns(2).Cells(i).Value
    lStart = lStart + lCopy
Next i

Rows("1:2").Delete
Range("A:H").Columns.AutoFit

Application.ScreenUpdating = True

End Sub

Hi,Sixthsense

code Allocate cp in DATA sheet correctly but need to insert row after cp name for whole row ,and one more thing after allocation code drag again cp name.

The provided code working fine for in the file which you have attached in Post #1

Originally Posted by :) Sixthsense :)

The provided code working fine for in the file which you have attached in Post #1

Ok got it Sixthsense Thank u very much.

Glad it helps you and thanks for the feedback and rep

If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED. Thanks.

Try the below code...

You have to select the Data range and Allocation Range Manually. Made it user defined range so than you can select your desired range on which the macro needs to be performed.

Sub ArrangeData()
Dim rData As Range, rAllocation As Range, rPaste As Range
Dim lRw As Long, lCopy As Long, lStart As Long

On Error Resume Next
Set rData = Application.InputBox("Select The DATA RAMGE", "Input DATA RANGE Required", , , , , , 8)

If rData Is Nothing Then GoTo InValidRange

Set rAllocation = Application.InputBox("Select The ALLOCATION RANGE" _
                & vbCrLf & vbCrLf & vbCrLf & "******EXCLUDING HEADER******", _
                "ALLOCATION RANGE Required" & vbCrLf & vbCrLf, , , , , , 8)

If rAllocation Is Nothing Then GoTo InValidRange

On Error GoTo 0
Application.ScreenUpdating = False

Sheets("Output").Select

For i = 1 To rAllocation.Rows.Count
    Set rPaste = Cells(Rows.Count, "A").End(xlUp)
    If rPaste.Row <> 1 Then Set rPaste = Cells(Rows.Count, "A").End(xlUp).Offset(2)
    If i = 1 Then lStart = rData.Row
    lCopy = rAllocation.Columns(3).Cells(i).Value
    rData.Rows(lStart).Resize(lCopy).Copy
    With rPaste
        .PasteSpecial xlPasteAll
        .Offset(, 5).Resize(lCopy).Value = rAllocation.Columns(2).Cells(i).Value
    End With
    lStart = lStart + lCopy
Next i

Range("A:H").Columns.AutoFit

Application.ScreenUpdating = True

Exit Sub

InValidRange:
    MsgBox "Invalid Input Selection Made/Provided", vbCritical, "Task Failed, Run It Again"

End Sub

Great Sixthsense,

It works fantastic thanku very much.
U save My 3 workinghours per day.

cheers.'''.

All the best.

Glad it helps you and once again thanks for the feedback

Hi Seixthsense,

I have one issue while alocating cp allocation,If in DATA sheet there is 2 or 3 Break in all col then what should i do and code allocating '-1' qty in output folder.
pls suggest

Please show a sample workbook to know in which circumstances the provided code is getting failed and for my testing purpose too...

Hi Sixthsense,

pls help if i select range manually for second lot code should drag from selected range, but i macro code draging another range.

pls help me out i have attached sample workbook.

Oopsss.... Just replace the below line

If i = 1 Then lStart = rData.Row

With

If i = 1 Then lStart = 1

Thanks once again Sixthsense.
Good Day.