Formula to offset based on a change

[HeyMike]

Hi,

I'm looking for a formula that will take the cells used as a heading and place them cell into columns with the corresponding rows under the heading.

I'm thinking that the formula will have an offset that counts the blank cells in column A then place the text from the heading cells (by heading cells I mean the ones that say "Type A" and "Code X") next to the rows with the products.

Maybe a VBA script? What do you think?

Thanks,
Mike

 

[Dosnox]

Hi Mike

It might be possible to do it by formula but I can't figure it out. So I just put together some vb code based on your screen shot.

Sub Code()
Dim myrange As Range
Dim Lastrow As Long
Dim Cell As Object
Dim string1, string2 As String
Lastrow = Cells(Rows.Count, 3).End(xlUp).Row
Set myrange = Range(Cells(3, 3), Cells(Lastrow, 3))
For Each Cell In myrange
If Cell.Value <> "" Then
string1 = Cells(Cell.Row, Cell.Column - 2).End(xlUp).Value
string2 = Cells(Cell.Row, Cell.Column - 1).End(xlUp).Value
Cells(Cell.Row, Cell.Column + 1) = string1
Cells(Cell.Row, Cell.Column + 2) = string2
End If
Next Cell
End Sub

Hope it helps.

 

[jasonb75]

Formula version, enter the formula in D4, then use the fill handle to copy the formula to E4 and sown as required.

=IF($C4="","",LOOKUP("ZZZZZZ",A$3:A3))

VBA version

Sub fill()
With Intersect(Range("A:B"), ActiveSheet.UsedRange).Offset(3, 3)
    .Formula = "=IF($C4="""","""",LOOKUP(""ZZZZZZ"",A$3:A3))"
    .Value = .Value
End With
End Sub

 

[PaddyD]

1) select the range of interest (in your example, a3:c20)
2) edit | go to | special | blanks
3) in a4 enter = a3. hit control + enter
4) edit | copy. edit | paste special - values

 

[HeyMike]

DOSNOX,

Your VBA script worked for placing the values from column A but not for column B. It just repeated the top row in column B.

Thanks!

Hi Mike

It might be possible to do it by formula but I can't figure it out. So I just put together some vb code based on your screen shot.

Sub Code()
Dim myrange As Range
Dim Lastrow As Long
Dim Cell As Object
Dim string1, string2 As String
Lastrow = Cells(Rows.Count, 3).End(xlUp).Row
Set myrange = Range(Cells(3, 3), Cells(Lastrow, 3))
For Each Cell In myrange
If Cell.Value <> "" Then
string1 = Cells(Cell.Row, Cell.Column - 2).End(xlUp).Value
string2 = Cells(Cell.Row, Cell.Column - 1).End(xlUp).Value
Cells(Cell.Row, Cell.Column + 1) = string1
Cells(Cell.Row, Cell.Column + 2) = string2
End If
Next Cell
End Sub

Hope it helps.

 

[HeyMike]

Paddy. This was awesome. Quick and easy.

1) select the range of interest (in your example, a3:c20)
2) edit | go to | special | blanks
3) in a4 enter = a3. hit control + enter
4) edit | copy. edit | paste special - values

 

[Dosnox]

Hey Mike

Sorry about that tested it on my spreadsheet and it works not sure why it didn't work for you mate. Glad your problem got solved.

 

[PaddyD]

No worries

Paddy. This was awesome. Quick and easy.