How do i continue the value of a newly created variable until a new value is found?

Question

I am currently using Excel 2003 and have a question but am unable to formulate without just showing pictures. Unfortunatley I cannot do that until I have 10 reputations(?). I will describe it the best I can.

I have a spreadsheet that has in column A bolded headers and then below it (starting also in column A) are records that fall under that heading. I tried to recreate it below, but please note: in the real spreadsheet there are no empty rows between any of the lines. The records are made up of 3 columns (the 3rd column in this case is made-up since the real spreadsheet contains confidential information).

**Fire**
05/07/2014      RP140028540   asdsfsfafk  
05/07/2014      RP140028541   asdsfsfafk    
05/07/2014      RP140028545   asdsfsfafk  
05/07/2014      RP140028548   asdsfsfafk    

**EMS**
05/07/2014      RP140028345   asdsfsfafk  
05/07/2014      RP140028549   asdsfsfafk    
05/07/2014      RP140028678   asdsfsfafk  

**Haz-Mat**
05/07/2014      RP140028111   asdsfsfafk  
05/07/2014      RP140028222   asdsfsfafk    
05/07/2014      RP140028333   asdsfsfafk  
05/07/2014      RP140028888   asdsfsfafk    
05/07/2014      RP140028284   asdsfsfafk  

I would like to create code that would take the values of column one (when bolded, and thus a header) and make then the values of a newly created variable in column D. The values would continue until a new header is reached and then the process starts over again. So it looks like this:

**Fire** 
05/07/2014      RP140028540   asdsfsfafk  Fire  
05/07/2014      RP140028541   asdsfsfafk  Fire    
05/07/2014      RP140028545   asdsfsfafk  Fire  
05/07/2014      RP140028548   asdsfsfafk  Fire  

**EMS**
05/07/2014      RP140028345   asdsfsfafk  EMS  
05/07/2014      RP140028549   asdsfsfafk  EMS    
05/07/2014      RP140028678   asdsfsfafk  EMS  

**Haz-Mat**
05/07/2014      RP140028111   asdsfsfafk  Haz-Mat  
05/07/2014      RP140028222   asdsfsfafk  Haz-Mat    
05/07/2014      RP140028333   asdsfsfafk  Haz-Mat  
05/07/2014      RP140028888   asdsfsfafk  Haz-Mat    
05/07/2014      RP140028284   asdsfsfafk  Haz-Mat 

I know the way to distinguish the heading from the records is by logic stating if the second column is blank, then the value of the fourth column equals the first column. But I am unsure how to make that logic continue for all of the records that fall under that heading.

The reason I would like to do this is twofold. One, I will be creating a report that only includes select groups and this is the easiest way for me to do that (since writing the code that keeps or deletes certain rows is about my only VB experience). But more importantly, eventually this information will be used in GIS and stratafied by those values. Therefore, I will need this column for future dataset use.

        Dim rowToTest As Long
For rowToTest = Cells(Rows.Count, 1).End(xlToRight).Row To 1 Step 1
With Cells(rowToTest, 1)
    If .Value <> "" And Cells(rowToTest, 3).Value = "" Then Cells(rowToTest, 5).Value = Cells(rowToTest, 1)
End With
Next rowToTest

I have looked online but because of my inability to explain what I am trying to do, I am unable to find code that will create the desired results. Listed above was code I hoping would at least let me copy the group header over to the empty cells..but it is not successful. In addition, I get stuck on how to pull the value down until a new value is reached. Any help would be much appreciated. Thank you.

Answer 1

Here's a possible formula-based solution:

Once you've filled down the formula you can copy/paste values.

In VBA:

Sub Tester()

Dim rowToTest As Long, header As String, sht As Worksheet
Dim lastRow As Long, rw As Range

Set sht = ActiveSheet
lastRow = sht.Cells(Rows.Count, 1).End(xlUp).Row
header = ""

For rowToTest = 1 To lastRow

    Set rw = sht.Rows(rowToTest)

    If Len(rw.Cells(1).Value) > 0 And Len(rw.Cells(2).Value) = 0 Then
        header = rw.Cells(1).Value
    ElseIf Application.CountA(rw.Cells(1).Resize(1, 3)) = 3 Then
        rw.Cells(4).Value = header
    Else
        'do nothing
    End If

Next rowToTest

End Sub