CODEWITHSUNDEEP
excelvbacopy-paste
kit99
kit99

Reputation: 187

Excel vba - How to copy/paste when range varies

Got a sheet holding 7000 rows. Data is in columns A-C. Column A is teams, B is persons, and C is towns. Row 1 holds headers. Cell A2 is the first team name. Cell B2: C23 is persons and towns (no empty cells). However, cell A3: A23 is empty. The team name is only written out for the first row of persons/towns.

Row 24 is blank. In A25 there is a new team name. B25:C38 is persons/towns. A26: A38 is empty.

What I want to do is to copy/paste team name in A2 down to empty cells in A3: A23. And then do the same with the team name in A25 to A26: A38. And so on down about 7000 rows for 370 teams.

But the number of rows in use for each team varies, so how can a VBA take this into account? The only fixed information is that there is an empty row between each team/person/town-section.

Upvotes: 0

Views: 449

Answers (3)

Lookaji
Lookaji

Reputation: 1043

I came up with a quick solution that takes into account blank lines:

Option Explicit

Sub completeTeams()
    Dim i As Long
    Const startDataRow = 2
    Dim lastDataRow As Long
    Dim lastTeamRow As Long

    Dim lastTeamFound As String
    Dim teamCellData As String

    Dim isEmptyLine As Boolean

    Rem getting the last row with data (so using column B or C)
    lastDataRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "B").End(xlUp).Row

    teamCellData = vbNullString
    lastTeamFound = ActiveSheet.Cells(startDataRow, "A").Text

    For i = startDataRow To lastDataRow
        Rem trying to get the actual team name
        teamCellData = ActiveSheet.Cells(i, "A").Text

        Rem check to skip empty lines
        isEmptyLine = Len(teamCellData) = 0 And Len(ActiveSheet.Cells(i, "B").Text) = 0
        If isEmptyLine Then GoTo skipBlankLine

        If Len(teamCellData) > 0 Then
            lastTeamFound = teamCellData
        End If

        ActiveSheet.Cells(i, "A").Value = lastTeamFound

skipBlankLine:
    Next

End Sub

Upvotes: 1

Darren Bartrup-Cook
Darren Bartrup-Cook

Reputation: 19737

If you're ok with a formula only approach you could add this formula to cell D2 and copy down. 

=IF(B2<>"",IF(A2="",D1,A2),"")

Then copy column D and paste values into column A.

Upvotes: 1

Guy Louzon
Guy Louzon

Reputation: 1203

Actually wrote such a script myselft a few years ago, since a lot of analytics toolds exports information to excel like that

Select the range you want to work on, i.e A1:A7000, and run the script:

Sub fill2()
 Dim cell As Object
 For Each cell In Selection
    If cell = "" Then cell = cell.OffSet(-1, 0)
 Next cell
End Sub

Upvotes: 0

Related Questions