VBA to Copy Cells with specific text and paste in adjacent/subsequent column if text is found

[SarahD139142]

I am beginner to VBA, so pardon my ignorance ... I have Department Data in Column B with Department Names as headers, all in the same column. I am trying to create a macro to copy the department name and paste into Column A when the data is found in Column B. I haven't been able to find any thread on any site that addresses this. I included an image of my data and highlighted the cells I am concerned about. I would like to take the blue cell and paste it in the orange cells, and continue this for 20,000 rows. However, there is variability in the number of orange rows. Any help is appreciated!!! or is this even possible, haha.

RevMan.xlsm
	A	B	C	D	E	F
12		Department: EG 4 EAST-211125
13		Charge Review Details by Rule
14			Charge Line Count	Session Count	Amount	Ratio to Pre AR
15		44 - PROCEDURE PRICE CANNOT BE EMPTY	1	1	0	0.00%
16		45 - PROCEDURE MUST BE IN AT LEAST ONE OF THE FEE SCHEDULES SEARCHED	1	1	0	0.00%
17		260001 - WARNING POS NEEDED FOR INPATIENT AND OUTPATIENT CHARGES	1	1	0	0.00%
18		607888 - CHOA PB CORRECT DEP CHARGE	1	1	0	0.00%
19		609863 - CHOA PB POS MUST HAVE LOCATION TYPE OF POS	1	1	0	0.00%
20
21		Department: EG 5 EAST-211130
22		Charge Review Details by Rule
23			Charge Line Count	Session Count	Amount	Ratio to Pre AR
24		260001 - WARNING POS NEEDED FOR INPATIENT AND OUTPATIENT CHARGES	1	1	0	0.00%
25		607888 - CHOA PB CORRECT DEP CHARGE	1	1	0	0.00%
26		609863 - CHOA PB POS MUST HAVE LOCATION TYPE OF POS	1	1	0	0.00%
Sheet4

 

[Fluff]

Hi & welcome to MrExcel.
Will you always have "Charge Review Details by Rule" in the row below the department, then a blank row & another blank row between the data & the next department?

 

[SarahD139142]

Yes, I will always want to copy the Department above "Charge Review Details by Rule", there will always be a blank row below "Charge Details by Rule", and then I will want to paste the Department in the column to the left of the cells (rules) below the blank row. It will always follow this same outline, but the variable is the number of rules/number of cells I need to paste the Department to. Thank you!!

 

[Fluff]

Ok, how about

Sub SarahD()
   Dim Rng As Range
      
   For Each Rng In Range("C2", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlConstants).Areas
      Rng.Offset(1, -2).Resize(Rng.Count - 1).Value = Rng.Offset(-2, -1).Resize(1).Value
   Next Rng
End Sub

 

[SarahD139142]

THANK YOU! It worked thank you!

 

[Fluff]

You're welcome & thanks for the feedback.