Dynamic field population VBA - vba

Question

I have written a script that simplifies a spreadsheet, but I need help with dynamically populating fields. The current format of the spreadsheet has inconsistent spacing so it is difficult to put together and if then statement that populates only populates subsections of a document.
I have attached an of the way the document looks.
What I am trying to do is populate the Highlighted fields on the left based on the highlighted field on the right. e.g. (When Field "F3" populated - If "2012" and "092000" then populate BBFY with "2012" from cell "F2" in cells "A4" to "A11" Stop at last BOC number".) Start same process at next process with next group of data. Then if there is new data for the BOC name 2013 092300, fill in the corresponding information based on that information.
I am just having trouble trying to identify the correct calls to many changes are making it difficult to tell the code to change values based on new parameters. As you can see the highlighted values in F change and thus change the related information below. I have blocked out where I am trying to start up this section of the code.
The code I have so far gets me to the layout you see below. In addition I am trying to make a new worksheet based off of each section, but I will try to tackle that another time.
Sub SOFCMacro()
'Begins Macro Optimizations
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
'Declarations
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim rng As Range
'Renames Sheet1 and Make It an Object
Set Main = ActiveSheet
Main.Name = "BAR"
'Add and Name Worksheets
Set WS1 = Sheets.Add
WS1.Name = "SOFC"
'Clear Formatting
Sheets("BAR").Activate
With ActiveSheet
.Cells.ClearFormats
End With
***'Comma Diliminate Funding Information
Sheets("Bar").Activate
With ActiveSheet
Set rng = .Range(rng, .Cells(.Rows.Count, rng.Column).End(xlUp))
For i = Last To 1 Step -1
If Not IsError(.vaule) Then
ElseIf (cells(i, "F").value = "092000:" and "Salaries:" Then cells(Cells, i, "A").value = (Cells(i, "F").Value) Like "20*"
ElseIf .value = "092300:" and "Defender:" Then cells(Cells, i, "A").value = (Cells(i, "F").Value) Like "20*"
ElseIf .value = "51140X:" and "Judiciary:" Then cells(Cells, i, "A").value = (Cells(i, "F").Value) Like "20*"
ElseIf .value = "51140E:" and "Electronic:" Then cells(Cells, i, "A").value = (Cells(i, "F").Value) Like "20*"
End if
End With***
'Copies Columns from Budget Availability Reports to SOFC Worksheet
Sheets("BAR").Columns(1).Copy Destination:=Sheets("SOFC").Columns(4)
Sheets("BAR").Columns(2).Copy Destination:=Sheets("SOFC").Columns(5)
Sheets("BAR").Columns(3).Copy Destination:=Sheets("SOFC").Columns(6)
Sheets("BAR").Columns(4).Copy Destination:=Sheets("SOFC").Columns(7)
'Deletes "Main Worksheet"
Sheets("BAR").Delete
'Inserts Header Row
Sheets("SOFC").Range("A2").EntireRow.Insert
'Add Headers to Sheet
Sheets("SOFC").Range("A1").Value = "BBFY"
Sheets("SOFC").Range("B1").Value = "EBFY"
Sheets("SOFC").Range("C1").Value = "FUND"
Sheets("SOFC").Range("D1").Value = "BUDGET ORG"
Sheets("SOFC").Range("E1").Value = "BOC"
Sheets("SOFC").Range("F1").Value = "BOC Name"
Sheets("SOFC").Range("G1").Value = "ALLOTMENT"
'Deletes Unneeded Rows
Sheets("SOFC").Activate
With ActiveSheet
Firstrow = .UsedRange.Cells(1).Row
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
For Lrow = Lastrow To Firstrow Step -1
With .Cells(Lrow, "D")
If Not IsError(.Value) Then
ElseIf .Value = "Activity Type:" Then .EntireRow.Delete
ElseIf .Value = "Activity:" Then .EntireRow.Delete
ElseIf .Value = "AO Division:" Then .EntireRow.Delete
End If
End With
Next Lrow
End With
'Deletes Rows Based On Criteria
Last = Cells(Rows.Count, "D").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "D").Value) = "Fund:" Then
'Cells(i, "A").EntireRow.ClearContents ' USE THIS TO CLEAR CONTENTS BUT NOT DELETE ROW
ElseIf (Cells(i, "D").Value) = "Activity Type:" Then
Cells(i, "A").EntireRow.Delete
ElseIf (Cells(i, "D").Value) = "Activity:" Then
Cells(i, "A").EntireRow.Delete
ElseIf (Cells(i, "D").Value) = "AO Division:" Then
Cells(i, "A").EntireRow.Delete
ElseIf (Cells(i, "D").Value) = " Org Code" Then
Cells(i, "A").EntireRow.Delete
ElseIf (Cells(i, "F").Value) = "Org Code Subtotal:" Then
Cells(i, "A").EntireRow.Delete
ElseIf (Cells(i, "F").Value) = "AO Division Subtotal:" Then
Cells(i, "A").EntireRow.Delete
ElseIf (Cells(i, "F").Value) = "Activity Subtotal:" Then
Cells(i, "A").EntireRow.Delete
ElseIf (Cells(i, "F").Value) = "Activity Type Subtotal:" Then
Cells(i, "A").EntireRow.Delete
ElseIf (Cells(i, "F").Value) = "Fund Subtotal:" Then
Cells(i, "A").EntireRow.Delete
'Change Values for Courts in Current Wave
ElseIf (Cells(i, "F").Value) = "ARW - Arkansas Western" Then
Cells(i, "A").EntireRow.Delete
ElseIf (Cells(i, "F").Value) = "CAN - California Northern" Then
Cells(i, "A").EntireRow.Delete
ElseIf (Cells(i, "F").Value) = "GAS - Georgia Southern" Then
Cells(i, "A").EntireRow.Delete
ElseIf (Cells(i, "F").Value) = "MDX - Maryland" Then
Cells(i, "A").EntireRow.Delete
ElseIf (Cells(i, "F").Value) = "NDX - North Dakota" Then
Cells(i, "A").EntireRow.Delete
ElseIf (Cells(i, "F").Value) = "NYE - New York Eastern" Then
Cells(i, "A").EntireRow.Delete
ElseIf (Cells(i, "F").Value) = "ORX - Oregon" Then
Cells(i, "A").EntireRow.Delete
ElseIf (Cells(i, "F").Value) = "SDX - South Dakota" Then
Cells(i, "A").EntireRow.Delete
'Change Values for Courts in Current Wave
ElseIf (Cells(i, "F").Value) = "" Then
Cells(i, "A").EntireRow.Delete
Else
End If
Next i
'Gets BBFY and Fund and Place Values in Correct Columns
'Last = Cells(Rows.Count, "D").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "D").Value) = "Fund:" Then
ElseIf (Cells(i, "F").Value) Like "20*" Then
YearYo = Left(Cells(i, "20*"), 4)
If Date Like "20*" Then
Cells(i, "A").Value = Date
End If
Else
End If
Next i
'Gets Leading 0 for Fund Code
Columns("C:C").Select
Selection.NumberFormat = "000000"
End Sub

Answer 1

One suggestion, if your spreadsheet is consistent in the BOC column, then maybe that's the best place to start.
Dim i as Integer
Dim j as Integer
Dim LR as Long
LR = Cells(Sheets("NAME").Columns(6).Rows.Count, 1).End(xlUp).Row
For j = 1 to LR
For i = 1 to 3
If Cells(j,i)/Value="" Then
Cells(j,i).Formula= 'come up with reference for the BOC Name
Else:
End If
Next i
Next j
It's not perfect and could probably be done better with a For Each (I'm not very good with those), but it could be at least a start. This option doesn't find dynamic ranges to fill in the blank (e.g. dynamically define the big yellow block of squares and paste into them). It just loops through all cells in the first 3 rows, til the end of the last row (used column F (Columns(6)) as is seems to be your only fully filled column).
If you want more specific to what goes into each cell:
Dim i as Integer
Dim LR as Long
LR = Cells(Sheets("NAME").Columns(6).Rows.Count, 1).End(xlUp).Row
For i = 1 to LR
If Cells(i,1)/Value="" Then
Cells(i,1).Formula= "=Left(REF,4)'come up with reference for the BOC Name
Cells(i,2).Formula= "=Left(Right(REF,6),11)
Cells(i,3).Formula= "=Right(REF,3)
Else:
End If
Next i