Loop for vba macro from a specific column to the last column with data

Hi all,


I need to create a macro that distributes proportionally a value into several columns taking into account that the value changes in each row. One important point is that the first column in which I have to start is previously stated.

Let's take that the value is 1000 and it must paste in each column 150, starting from the thirth. I would have 0,0,150,150,150,150,150,150, and in the next one only 50 (what I have left) . In the rest, all would be 0 again, until the last one.

The loops I'm creating don't work because I'm unable to count all the cells with data in each row (I'm using "endd = Cells(1, Cells.Columns.Count).End(xlToRight).Column")
but I'm sure there are more wrong things over there.

I know that there are here many very good experts... Would be anyone of you able to give a macro capable to do all these things??



Thank very much in advance for your kind answers.

Could you post a workbook so we can see your set up?

Originally Posted by StephenR

Could you post a workbook so we can see your set up?

Thank you for your response, StephenR.

Do you mean anything like this?

Worksheets("NUMBER").Select

startt = Range("B2")

'Selection.End(xlToRight).Select

'endd = ActiveCell.Column

Worksheets("Sheet1").Select
'endd = Cells(1, Cells.Columns.Count).End(xlToRight).Column

For i = 2 To 25
totalnumber = Range(i, 1)

For j = 3 To endd

totalnumber = Range(i, 1)



Range(i, j) = 160

totalnumber = totalnumber - 160


If totalnumber < 160 Then
If totalnumber > 0 Then

Range(i, j) = totalnumber
Else
Range(i, j) = 0
End If
End If



Next j
Next i

End Sub

Not quite! First, please can you add code tags to your post as per forum rules?

Is this code your attempt which does not work?

What I was asking for is for you to upload a workbook containing some data so we can see how it is arranged and how the results should appear. I don't know where the 1000, 150 etc come from.

tabla.jpg


Sorry, I hope this is closer to what you were asking for....

Could you post a workbook please, not a picture. It saves me from having to make something up.

And please add the code tags as I asked last time.

Sub Automation()


 Dim i As Long
 Dim j As Long
 
 

Worksheets("NUMBER").Select

startt = Range("B2")

'Selection.End(xlToRight).Select

'endd = ActiveCell.Column

Worksheets("Sheet1").Select
'endd = Cells(1, Cells.Columns.Count).End(xlToRight).Column

For i = 2 To 25
totalnumber = Range(i, 1)

For j = 3 To endd

 totalnumber = Range(i, 1)
 
   
 
 Range(i, j) = 160
 
 totalnumber = totalnumber - 160
 
 
 If totalnumber < 160 Then
 If totalnumber > 0 Then
 
 Range(i, j) = totalnumber
 Else
 Range(i, j) = 0
 End If
 End If
 


Next j
Next i




End Sub

I appologise, but I can't find how to upload a whole workbook. I don't have any activated icon for attaching files....

Attach a sample workbook. Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and then scroll down to Manage Attachments to open the upload window.

I think so. One thing - if the start month is 7 does that mean the numbers should only start from March 2017 (the 7th month across)?

Originally Posted by StephenR

I think so. One thing - if the start month is 7 does that mean the numbers should only start from March 2017 (the 7th month across)?

This is just a random number I typed to test the macro. It's a variable itself and corresponds to the starting point. Let's say that the first non-zero value in each column is the first month whose number is the number of that cell.

Example 1: Number 7 --> july -->column N
Example 2: Number 10---> october --> column E

I know it's a bit confusing, but I think it simplifies the process, after all....

Thank you again for the selfless effort you're making.

See if this starts you off - I'm just not clear about the start month

Sub x()

Dim r As Long, c As Long

Const n As Long = 160

Sheet2.Activate

For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    c = 1
    Do While WorksheetFunction.Sum(Cells(r, 4).Resize(, c)) < Cells(r, 1)
        If Cells(r, 1) - WorksheetFunction.Sum(Cells(r, 4).Resize(, c)) < n Then
            Cells(r, 3 + c) = Cells(r, 1) - WorksheetFunction.Sum(Cells(r, 4).Resize(, c))
        Else
            Cells(r, 3 + c) = n
        End If
        c = c + 1
    Loop
Next r

End Sub

Originally Posted by StephenR

See if this starts you off - I'm just not clear about the start month

Sub x()

Dim r As Long, c As Long

Const n As Long = 160

Sheet2.Activate

For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    c = 1
    Do While WorksheetFunction.Sum(Cells(r, 4).Resize(, c)) < Cells(r, 1)
        If Cells(r, 1) - WorksheetFunction.Sum(Cells(r, 4).Resize(, c)) < n Then
            Cells(r, 3 + c) = Cells(r, 1) - WorksheetFunction.Sum(Cells(r, 4).Resize(, c))
        Else
            Cells(r, 3 + c) = n
        End If
        c = c + 1
    Loop
Next r

End Sub

Thanks for your code, Stephan. It is not far from what I was looking for, but I would like to start in each row in the month of the date of the second column.

On the other hand, all blanks in the table should be zero numbers.

Thank you!

What if the month in the second column doesn't appear in the top row or is blank - there are a lot of them?

Good question. Then I think that we may consider all the correspondent row values to be zero.

... Or we can just let what the macro displays without further changes.... These rows are not important, really....

OK, give this a try

Sub x()

Dim r As Long, c As Long, rData As Range, i

Const n As Long = 160

Sheet2.Activate

Set rData = Range("A1").CurrentRegion

For r = 2 To rData.Rows.Count
    i = Application.Match(CLng(DateSerial(Year(Cells(r, 2)), Month(Cells(r, 2)), 1)), rData.Rows(1), 0)
    If IsNumeric(i) Then
        c = 1
        Do While WorksheetFunction.Sum(Cells(r, i).Resize(, c)) < Cells(r, 1)
            If Cells(r, 1) - WorksheetFunction.Sum(Cells(r, i).Resize(, c)) < n Then
                Cells(r, i - 1 + c) = Cells(r, 1) - WorksheetFunction.Sum(Cells(r, i).Resize(, c))
            Else
                Cells(r, i - 1 + c) = n
            End If
            c = c + 1
        Loop
    End If
Next r

With rData
    .Offset(1, 3).Resize(.Rows.Count - 1, .Columns.Count - 3).SpecialCells(xlCellTypeBlanks).Value = 0
End With

End Sub

Run-time error '1004'
Application-defined or object-defined error

here: .Offset(1, 3).Resize(.Rows.Count - 1, .Columns.Count - 3).SpecialCells(xlCellTypeBlanks).Value = 0

Worked for me on your example file - are you trying it elsewhere?

It's only your file, but am having trouble attaching a workbook. Can you try uploading a file with the code?

Here you go.


is it your macro able to associate the date month to the right column?

Here you go.


is it your macro able to associate the date month to the right column?

Here you go.



is it your macro capable to associate the date month in column 2 to the right top row value?

I see you're having trouble with the forum too! It's all messed up here at the moment.

Try changing this line as below

Set rData = Sheet2.Range("A1").CurrentRegion

I works perfectly!!!! Thank you again, and again, and again for taking your time to help me.

Reputation added for you! You deserve it!

I works perfectly!!!! Thank you again, and again, and again for taking your time to help me.

Reputation added for you! You deserve it!