Populate formula results in cells to next unique result. VBA or Fu

  • Thread starter Thread starter Sandy Crowley
  • Start date Start date
S

Sandy Crowley

Thank you for looking at my question.

Currently 20,000 rows:
column A2 =IF(FIND("Project: ",$F2),MID($F2,11,9),)
column B2 =IF(FIND("Project: ",$F2),MID($F2,23,99),)
column C2 =IF(FIND("Client: ",$G2),MID($G2,9,5),)
column D2 =IF(FIND("Client: ",$G2),MID($G2,16,55),)
column E2 =IF(FIND("Responsible_Employee_Name_1: ",$F2),MID($F2,31,75),)

column F2 may or may not contain: "Responsible_Employee_Name_1: ADAMS, GARY"
OR "Project: 161277306 PHASE 4 LPL EMERGENCY GENERATOR"
OR "Client: C8200 LPL FINANCIAL SERVICES"
OR Various Other Data

The formula in A2 returns "161277306"
B2 returns "PHASE 4 LPL EMERGENCY GENERATOR"
C2 returns "C8200"
D2 returns "LPL FINANCIAL SERVICES"
E2 returns "ADAMS, GARY"

I need the blank cells, below the immediate formula, ex: A3:E7 to autofill
down with formula results until the next row is true and then fill down again
(example) If row F8 contains 161277399 then return in A8 and fill that down
until the next row has a new result.

Is this possible with formulas or do I need to go into VBA?

If VBA then how do I accomplish it within:
Sub fixGetProjectInfo()
'
' GetProjectInfo
'

'This deletes unwanted headings rows
Rows("1:9").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
'Insert columns for formulas
Selection.EntireColumn.Insert
Selection.EntireColumn.Insert
Selection.EntireColumn.Insert
Selection.EntireColumn.Insert
Selection.EntireColumn.Insert
Windows("pct comp all_1108.xls").Activate
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Windows("pct comp eng_land_1108_2.xls").Activate
ActiveCell.FormulaR1C1 = "Project"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Project Name"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Client"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Client name"
Range("E1").Select
ActiveCell.FormulaR1C1 = "EVC"
Range("A2").Select
ActiveCell.FormulaR1C1 = _
"=IF(FIND(""Project: "",RC6),MID(RC6,11,9),""nothing"")"
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=IF(FIND(""Project: "",RC6),MID(RC6,23,99),""nothing"")"
Range("C2").Select
ActiveCell.FormulaR1C1 = "=IF(FIND(""Client:
"",RC7),MID(RC7,9,5),""nothing"")"
Range("D2").Select
ActiveCell.FormulaR1C1 = _
"=IF(FIND(""Client: "",RC7),MID(RC7,16,55),""nothing"")"
Range("E2").Select
ActiveCell.FormulaR1C1 = _
"=IF(FIND(""Responsible_Employee_Name_1:
"",RC6),MID(RC6,31,75),""nothing"")"
Range("A2:E1133").Select
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Cells.Replace What:="#VALUE!", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
 
Back
Top