当列中出现的文本在一定范围内时，如何自动调整行？

Question

I have two questions that I've broken up one I already asked this is the most important one. I pull data from a web-based tool and it imports to excel.

There is a Swimlane in column B and in that column it has different departments the problem is only some of the names are there. Some rows that don't have the name implies that the preceding department name in Column B is applied to that row and so forth.

I recorded a macro but the problem is rows can and do get deleted. There are 50+ sheets to auto adjust each department name in column b so it's extremely cumbersome.

It starts at row 15 in Column B. Logic is:

IF Column B contains something then auto adjust or double click to make it copy all the way down until the next department name. The BLANK in the example is the portion I need to double click "Grocery, Dairy, or Seafood" so it fills in the blank with the preceding department title.

Example: Swimlane

Row  1    "Grocery"     
Row  2     BLANK
Row  3     BLANK
Row  4     BLANK
Row  5    "Dairy"
Row  6     BLANK
Row  7     BLANK
Row  8     BLANK
Row  9    "Seafood"
Row 10     BLANK
Row 11     BLANK

What I previously had was a recorded macro that looked like this:

Sub Swimlane()
'
' Swimlane Macro
'
' Keyboard Shortcut: Ctrl+s
'
    Range("A107").Select
    Selection.AutoFill Destination:=Range("A107:A108")
    Range("A107:A108").Select
    Range("A100").Select
    Selection.AutoFill Destination:=Range("A100:A106")
    Range("A100:A106").Select
    ActiveWindow.SmallScroll Down:=-15
    Range("A86").Select
    Selection.AutoFill Destination:=Range("A86:A99")
    Range("A86:A99").Select
    Range("A80").Select
    Selection.AutoFill Destination:=Range("A80:A85")
    Range("A80:A85").Select
    ActiveWindow.SmallScroll Down:=-15
    Range("A69").Select
    Selection.AutoFill Destination:=Range("A69:A79")
    Range("A69:A79").Select
    Range("A64").Select
    Selection.AutoFill Destination:=Range("A64:A67")
End Sub

Any suggestions would be greatly appreciated !!!

Answer 1

Here's a macro that will loop through each worksheet, autofit column B, then copy your data down:

Sub formatAndCopyDown()
Dim i As Integer, lastCol As Integer, lastRow As Long, newLastRow As Long
Dim ws As Worksheet, wb As Workbook
Dim startCell As Range, copyFrom As Range

Set wb = ActiveWorkbook


For Each ws In wb.Sheets
    If WorksheetFunction.CountA(Range("B:B")) > 1 Then
        Debug.Print "Something in col. B"
        Columns(2).AutoFit

        lastRow = Cells(1048576, 2).End(xlUp).Row ' Change this to Cells(..,1) if you have data in Col. A you want the titles to be next to

        Set startCell = Cells(1, 2)
        Do While startCell.Row < lastRow
            If startCell.End(xlDown).Offset(-1, 0).Row > lastRow Then
                newLastRow = lastRow
            Else
                ' Edit this - this is the value newLastRow will be IF you reach the last entry in your col. B
                newLastRow = startCell.End(xlDown).Offset(-1, 0).Row
            End If
            Set copyFrom = startCell
            Range(Cells(startCell.Row, 2), Cells(newLastRow, 2)).Value = copyFrom.Value
            Set startCell = startCell.End(xlDown)
        Loop

    End If
Next ws

End Sub

Note: This assumes your Column B is independent of any other range. Because of that, you'll notice the last cell with Seafood never gets copied down. Why? Because I don't know what the next lastRow will be. If I copied down, it'd go to the end of the spreadsheet, and I don't think that's your intention.

If, however, you have data like this:

    A          B
1   Apples    Grocery
2   Bananas 
3   Oranges 
4   Cherries    
5   Milk      Dairy
6   Yogurt  
7   Cheese  
8   Cheese  
9   Fish      Seafood
10  Talapia 
11  Tuna    

where you want your labels to be next to the items (ie Seafood should also be next to Talapia and Tuna), then change the line lastRow = Cells(1048576,2).End... to lastRow = Cells(1048576,1).End...

This will loop and, if your pasteRange is going to go to the end of the spreadsheet, it'll instead use Column A's last cell as the final cell row. Does that make sense?