VBA to divide and assign rows

nicolas877

New Member
Joined
Jan 15, 2022
Messages
13
Office Version
  1. 2019
Platform
  1. Windows
Hi forum, i came across with this problem. I need to divide certain rows by an input number to assign them to people. Like This

CASE - NAME
777
333
999
993
101
190

to this...(in this will be dividing by 3, to assign 3 people)

CASE - NAME
777 Juan
333 Juan
999 Kate
993 Kate
101 Leon
190 Leon

But the quantity of names can be variable , line 2 names ,3 names, 4 names...so there is a way to divide all the rows by certain input in a msg box an then assign a name to each division ? I only know static division by 2 in the middle with MidRow command. Thank you in advance
 
A non-VBA approach:

ABCDE
1CasesAllocationNamesNo
2777JuanJuan1
3333JuanKate4
4999JuanLeon6
5993Kate
6101Kate
7190Leon
8888Leon
Sheet1
Cell Formulas
RangeFormula
E3:E4E3=E2+INT(ROWS(Cases)/ROWS(Names))+(ROWS(E$3:E3)<=MOD(ROWS(Cases),ROWS(Names)))
B2:B8B2=INDEX(Names,MATCH(ROWS(B$2:B2),No,1))
Named Ranges
NameRefers ToCells
Cases=Sheet1!$A$2:$A$8E3:E4
Names=Sheet1!$D$2:$D$4B2:B8, E3:E4
No=Sheet1!$E$2:$E$4B2:B8, E3
 
Upvote 0

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
In B1, put the formula
=IF(A1="", "", INDEX(D:D, COUNTA(D:D)-MOD(ROW(A1),COUNTA(D:D)), 1)) and drag down

The list won't start with Juan, but it will cover everyone as equally as possible.
 
Upvote 0
Thank you all for your great ideas, the vba code bebo021999 wrote works bests for me because its for an office enviroment when you cant really trust in people with formulas.
 
Upvote 0
Assum case is from A1, name from B1
This code will ask for how many names input, then name 1, then name 2,...
Then paste the name list into column C, then assign each name in column B
VBA Code:
Option Explicit
Sub divide()
Dim Lr&, Nr&, i&, k&, arr()
Lr = Cells(Rows.Count, "A").End(xlUp).Row
Nr = InputBox("How many people?")
ReDim arr(1 To Lr, 1 To 1)
Range("C:C").ClearContents
    For i = 1 To Nr
        Range("C" & i).Value = InputBox(" person " & i & " name:")
    Next
        For i = 1 To Lr
            k = Int((i - 1) / (Int(Lr / Nr) + 1)) + 1
            arr(i, 1) = Range("C" & k).Value
        Next
Range("B1").Resize(Lr, 1).Value = arr
End Sub
Unfortunately i got a problem with this, first it erase de b1 cell (name) and the most important ; if i have 17 rows to fill for example (b2 to b18) it divides 7-7-4 and i need something like 6-6-5
 
Upvote 0
If column A started from A2, and paste to B2:
VBA Code:
Option Explicit
Sub divide()
Dim Lr&, Nr&, i&, k&, arr()
Lr = Cells(Rows.Count, "A").End(xlUp).Row - 1 ' If from A2, Lr-1, if A3, Lr-2,...
Nr = InputBox("How many people?")
ReDim arr(1 To Lr, 1 To 1)
Range("C:C").ClearContents
    For i = 1 To Nr
        Range("C" & i).Value = InputBox(" person " & i & " name:")
    Next
        For i = 1 To Lr
            k = Int((i - 1) / (Int(Lr / Nr) + 1)) + 1
            arr(i, 1) = Range("C" & k).Value
        Next
Range("B2").Resize(Lr, 1).Value = arr
End Sub
If it does not work, try to post image/screesshot display what is expected outcome.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,211
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top