First post here. I have a rather unique situation. I have a personal project I am working on that involves Microsoft Visual Basic and I am hoping to get some advice on how this code should be structured and what changes need to be made to achieve what I believe is achievable.

Background: I have Macro that currently grabs data from one page, and pastes it into another page, following a specific format, distributing the values evenly, while omitting others based on a simple validation of if a corresponding cell in the same row has data.

Goal: What I am wanting to do is to expand this Macro to, when pasting the data onto Sheet2, it checks another range on Sheet2, and if that range has specific data within it, it will not paste data into that corresponding row, but still distribute all data from the previous sheet into the remaining rows as evenly as possible.

I was expecting this block of code to achieve my goal, but currently when it runs, it only populates one columns worth of data, and then seems to just die.

Sub EvenlyDistributeDataExcludeNames()
    Dim sourceSheet As Worksheet
    Dim destinationSheet As Worksheet
    Dim sourceRange As Range
    Dim destinationRange As Range
    Dim filteredArray() As Variant
    Dim numRows As Integer
    Dim numColumns As Integer
    Dim totalCells As Integer
    Dim cellsToFill As Integer
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim numRowsToPopulate As Integer 
    Dim currentColumn As Integer 

    Set sourceSheet = ThisWorkbook.Sheets("Pending")

    Set destinationSheet = ThisWorkbook.Sheets("Distributed")

    Set sourceRange = sourceSheet.Range("A2:A100")

    numRowsToPopulate = destinationSheet.Range("R27").Value

    ReDim filteredArray(1 To numRowsToPopulate, 1 To 1)

    ' Filter out values based on corresponding cells in column D
    k = 1
    For i = 1 To sourceRange.Rows.Count
        If IsEmpty(sourceSheet.Cells(i + 1, 4)) Then
            filteredArray(k, 1) = sourceSheet.Cells(i + 1, 1).Value
            k = k + 1
            If k > numRowsToPopulate Then Exit For 
        End If
    Next i

    ' Calculate the number of rows and columns in the filtered array
    numRows = UBound(filteredArray, 1)
    numColumns = 9 ' Number of columns in the destination range (C3:O11)
    currentColumn = 3 ' Start pasting data in column C

    ' Loop until all data is pasted
    k = 1
    Do While k <= numRows
        Set destinationRange = destinationSheet.Cells(3, currentColumn).Resize(numRowsToPopulate, 1) ' Resize to the number of rows to populate

        For i = 1 To numRowsToPopulate
            If k <= numRows Then
                destinationRange.Cells(i, 1).Value = filteredArray(k, 1)
                k = k + 1
            End If
        Next i

        currentColumn = currentColumn + 1
    Loop
End Sub
0

There are 0 best solutions below