cell value mapping to another cell from sheet in VBA

[mayaa_mmm]

Names	Output
Arul	CS
Mala	CS
Shan	CS
Selv	SW
Mani	SW
Muthu	SW

I need to find the count of Column A .Examples Column A have count of 6 in worksheet. I need to divide the count of column A and assisgn the work between two names based on the another sheet

Assisgn
CS
SW

if the Count of column A is odd, EXample count is 5, It can assign the to name CS -3 times SW-2 times.

is it possible to code in VBA?

 

[Sahak]

Hi Mayaa,

Try This:

Sub Make_Output()
    Dim rng_A As Range
    Dim CntNms, dv, rm As Integer
    Set rng_A = Worksheets("Sheet1").Range("A:A")
    CntNms = WorksheetFunction.CountA(rng_A) - 1  'Count of names in column A
    dv = WorksheetFunction.Quotient(CntNms, 2) ' integer portion of a division
    rm = CntNms Mod 2  'remainder of a division
    
    If rm = 0 Then
        Range(Worksheets("Sheet1").Range("B2"), Worksheets("Sheet1").Range("B" & dv + 1)) = Worksheets("Sheet2").Range("A2").Value
        Range(Worksheets("Sheet1").Range("B" & dv + 2), Worksheets("Sheet1").Range("B" & dv + dv + 1)) = Worksheets("Sheet2").Range("A3").Value
    Else
        Range(Worksheets("Sheet1").Range("B2"), Worksheets("Sheet1").Range("B" & dv + 2)) = Worksheets("Sheet2").Range("A2").Value
        Range(Worksheets("Sheet1").Range("B" & dv + 3), Worksheets("Sheet1").Range("B" & dv + dv + 2)) = Worksheets("Sheet2").Range("A3").Value
    End If
    
End Sub

See attached too

 

[mayaa_mmm]

Hi Mayaa,

Try This:

Sub Make_Output()
    Dim rng_A As Range
    Dim CntNms, dv, rm As Integer
    Set rng_A = Worksheets("Sheet1").Range("A:A")
    CntNms = WorksheetFunction.CountA(rng_A) - 1  'Count of names in column A
    dv = WorksheetFunction.Quotient(CntNms, 2) ' integer portion of a division
    rm = CntNms Mod 2  'remainder of a division
   
    If rm = 0 Then
        Range(Worksheets("Sheet1").Range("B2"), Worksheets("Sheet1").Range("B" & dv + 1)) = Worksheets("Sheet2").Range("A2").Value
        Range(Worksheets("Sheet1").Range("B" & dv + 2), Worksheets("Sheet1").Range("B" & dv + dv + 1)) = Worksheets("Sheet2").Range("A3").Value
    Else
        Range(Worksheets("Sheet1").Range("B2"), Worksheets("Sheet1").Range("B" & dv + 2)) = Worksheets("Sheet2").Range("A2").Value
        Range(Worksheets("Sheet1").Range("B" & dv + 3), Worksheets("Sheet1").Range("B" & dv + dv + 2)) = Worksheets("Sheet2").Range("A3").Value
    End If
   
End Sub

See attached too

Really awesome it is working good as i wanted.. Brilliant Coding