I just want headers above each category in a column

[kadain]

hi guys/gals
am just looking for a vba code that reads up a table column B, copys the first none blank value in its finds and pastes it to the next blank column then repeats
ive tried many different ways of trying it but no luck to the point it deletes everything but the headers it made

just so yous have an idea of how the data would look and what column the list goes on for ever so any range I would just go to max cell
all I really want is headers between each type of sub category
so if it was pasted bold and underlined that would be perfect

 

[alansidman]

We cannot manipulate data in a picture. Please re upload same data using XL2BB. See my signature for instructions.

 

[kadain]

We cannot manipulate data in a picture. Please re upload same data using XL2BB. See my signature for instructions.

VBA Test Book.xlsm
	A	B	C	D	E
1	Product Code	Product Sub Category	Product Description	Product Size	Pack Size
2
3	123	Cider	KOPPARBERG MIXED TROPICAL FRUIT 4% 500ML NRB	15x500ML B	1
4	1223124	Cider	KOPPARBERG STRAWBERRY ANDLIME 4% 500ML NRB	15x500ML B	1
5	131231	Cider	KOPPARBERG MIXED FRUIT 4%500ML NRB	15x500ML B	1
6	42414	Cider	MAGNERS IRISH CIDER 4.5% 568ML NRB	12x568ML B	1
7
8
9	123123123	Premium Lager	BUDWEISER LAGER 4.5% 330ML NRB	24x330ML B	1
10
11
12	412444	Standard Lager	BECKS BIER 4.8% 275ML	24x275ML B	1
13	42442	Standard Lager	MILLER GENUINE DRAFT 4.7%330ML NRB	24x NRB	1
14
15
16	34535	Std Ale / Ipa	NEWCASTLE BROWN ALE 4.7%550ML NRB	12x550ML B	1
17
18
19	35435	World Beer	CORONA EXTRA LAGER 4.5% 330ML NRB	24x330ML B	1
20	22555	World Beer	PERONI NASTRO AZZURO 5.1%330ML NRB	24x330ML B	1
21
22
23	5235352	Low Alcohol Beer	HEINEKEN 0.0% NON ALCOHOLIC LAGER BEER 330ML NRB	24x NRB	1
24
25
26	1606W	Pre-Mixed Drinks	SMIRNOFF ICE 4% 275ML	24x NRB	1
27	9629L	Pre-Mixed Drinks	WKD BLUE 4%	24x NRB	1
Sheet1

 

[alansidman]

Here is a VBA code to make that happen

Option Explicit

Sub ProdDesc()
    Dim lr As Long, i As Long
    Application.ScreenUpdating = False
    lr = Range("A" & Rows.Count).End(xlUp).Row
    For i = 3 To lr
        If Range("B" & i - 1) = "" Then
            Range("B" & i - 1) = Range("B" & i)
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "complete"
End Sub

 

[kadain]

We cannot manipulate data in a picture. Please re upload same data using XL2BB. See my signature for instructions.

Here is a VBA code to make that happen

Option Explicit

Sub ProdDesc()
    Dim lr As Long, i As Long
    Application.ScreenUpdating = False
    lr = Range("A" & Rows.Count).End(xlUp).Row
    For i = 3 To lr
        If Range("B" & i - 1) = "" Then
            Range("B" & i - 1) = Range("B" & i)
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "complete"
End Sub

Thank you so much, i dont think i would of been able to figure this out my self.
if youve got time could you run me threw the steps so i can understand the code a little better
it works wonders with the exsisting code ive wrote and ties in neatly

 

[alansidman]

Option Explicit

Sub ProdDesc()
    Dim lr As Long, i As Long 'Define your variables as long integers
    Application.ScreenUpdating = False 'Set the screen to not flashing
    lr = Range("A" & Rows.Count).End(xlUp).Row 'Determine the last row in column A
    For i = 3 To lr 'set loop to move through rows number 3 to last row
        If Range("B" & i - 1) = "" Then 'if the range of data in the one row above the looped row is empty then the next line of code
            Range("B" & i - 1) = Range("B" & i) 'if the above line of code is true then make the row above the looped row the same as the looped row
        End If 'stop the if--then scenario
    Next i 'loop to the next row
    Application.ScreenUpdating = True 'activate the screen
    MsgBox "complete"
End Sub

 

[Usually_Confused]

Hey @alansidman,

Colleague of *kadain here. Really appreciate your timely help. We were struggling with this for a couple of days and your code did the trick in a couple of minutes!

Where do we give 5 stars?

Thanks again!

 

[alansidman]

No Stars here, just click on the Like in the lower right corner. Your thanks is all that is needed. Glad to hear it is working for you.

 

[Usually_Confused]

Done

* * * * *