Hello, I am working on being clearer/more concise when referring to code, so I've put notes within the code to help tell a story... please let me know if you have any questions.
The code I've been able to pull together is great, but I can't quite get the last step down which is killing me! I'm just not sure what the best way to go about it is, so I would truly appreciate anyone out there who has the brain capacity to help me cross the finish line.
Code Steps:
Clear rows of data and custom column headers (these are months... each situation may require a different number of months, so I want to clear
these column headers, but leave the first group of columns which are always required fields)
Inserts the "column headers" aka months required (jan-2016, feb-2016.....Dec-2018
Inserts the monthly values for each month in all rows
The code I've been able to pull together is great, but I can't quite get the last step down which is killing me! I'm just not sure what the best way to go about it is, so I would truly appreciate anyone out there who has the brain capacity to help me cross the finish line.
Code Steps:
- (1) Delete custom fields added on prior use of model, between column B "Resource ID" and (former) column C "Burden Pool ID"
Clear rows of data and custom column headers (these are months... each situation may require a different number of months, so I want to clear
these column headers, but leave the first group of columns which are always required fields)
- (2) Copies the data for fields 1-5 from the "Staffing Plan" worksheet to the "Import" worksheet
Inserts the "column headers" aka months required (jan-2016, feb-2016.....Dec-2018
Inserts the monthly values for each month in all rows
- (3) Inserts column headers for the custom fields
- (4) Copy data for custom fields from the column with a matching column header on the "Staffing Plan" worksheet
Code:
Sub Module()
Dim wb As ThisWorkbook
Dim Sh As Worksheet
Dim CopyRng As Range
Dim Pricing As Worksheet
Dim BaseDate As Range
Dim BaseDate_Full As Range
Dim Heading_Month_1 As Range
Dim Num_Months As Integer
Dim Dest_Sh As Worksheet
Dim Dest_Start_Row As Integer
Dim Dest_End_Row As Integer
Dim Dest_End_Column As Integer
Dim Dest_Start_Row_2 As Integer
Dim Dest_End_Row_2 As Integer
Dim Source_Sh As Worksheet
Dim Source_Start_Row As Integer
Dim Source_End_Row As Integer
Dim N As Long
Dim Column_C As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'(1.) Delete custom fields from last time and clear contents from destination worksheet
Set Dest_Sh = Sheets("IMPORT")
On Error Resume Next
Dest_Sh.Visible = True
Dest_Sh.Activate
On Error GoTo 0
Dest_End_Row = Dest_Sh.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Dest_End_Column = Dest_Sh.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
Column_C = Dest_Sh.Cells(1, Columns.Count).End(xlToLeft).Column
'DELETES CUSTOM FIELDS BETWEEN "BURDEN POOL" AND "RESOURCE ID" FIELD
On Error Resume Next
For C = Column_C To 2 Step -1
If Cells(1, C).Value = "Burden Pool ID" And Cells(1, C - 1).Value <> "Resource ID" Then
Columns(C - 1).EntireColumn.Delete
End If
Next C
On Error GoTo 0
'DELETES DATA IN ROWS, EXCEPT HEADERS
If Dest_End_Row > 1 Then
Dest_Sh.Rows("2:" & Dest_End_Row).EntireRow.Delete
End If
'DELETES COLUMNS (USED TO CLEAR THE HEADERS IN COLUMNS TO THE RIGHT - WHICH WILL BE RE-ADDED LATER)
If Dest_End_Column > 8 Then
Dest_Sh.Range(Cells(1, 9), Cells(1, Dest_End_Column)).EntireColumn.Delete
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'(2.) Copy source data and paste to destination worksheet
Set Source_Sh = Sheets("Staffing Plan")
Source_End_Row = Source_Sh.Range("K" & Rows.Count).End(xlUp).Row
On Error Resume Next
Dest_Sh.Visible = True
Dest_Sh.Activate
On Error GoTo 0
'FIELD 1
Dest_Start_Row = Dest_Sh.Range("A" & Rows.Count).End(xlUp).Row + 1
Set CopyRng = Source_Sh.Range("B14", "B" & Source_End_Row)
CopyRng.Copy
With Dest_Sh.Range("A" & Dest_Start_Row)
.PasteSpecial 8 ' Column width
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
'FIELD 2
Dest_End_Row_2 = Dest_Sh.Cells(Rows.Count, "A").End(xlUp).Row
Set CopyRng = Source_Sh.Range("K14", "K" & Source_End_Row)
CopyRng.Copy
With Dest_Sh.Range("B" & Dest_Start_Row)
.PasteSpecial 8 ' Column width
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
'FIELD 3
Set CopyRng = Source_Sh.Range("AA14", "AA" & Source_End_Row)
CopyRng.Copy
With Dest_Sh.Range("C" & Dest_Start_Row)
.PasteSpecial 8 ' Column width
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
'FIELD 4
If Dest_End_Row > 1 Then
Dest_Sh.Range(Cells(Dest_Start_Row, 7), Cells(Dest_End_Row_2, 7)).Formula = "D"
End If
'FIELD 5
Set Pricing = Sheets("Pricing")
Pricing.Visible = True
Set BaseDate = Pricing.Range("$I$16")
BaseDate.Copy
With Dest_Sh.Range("H" & Dest_Start_Row, "H" & Dest_End_Row_2)
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
Set BaseDate_Full = Pricing.Range("$I$14")
BaseDate_Full.Copy
With Dest_Sh.Range("$I$1")
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
'COLUMN HEADERS (MONTHS)
Set Heading_Month_1 = Dest_Sh.Range("$I$1")
Num_Months = Pricing.Range("$I$19")
If Heading_Month_1 > 0 Then
Dest_Sh.Range(Cells(1, 10), Cells(1, 8 + Num_Months)).Formula = "=DATE(YEAR(I$1),MONTH(I$1)+1,DAY(I$1))"
End If
'MONTHLY VALUES
With Source_Sh
Set CopyRng = .Range(.Cells(14, 50), .Cells(Source_End_Row, 49 + Num_Months))
End With
CopyRng.Copy
With Dest_Sh.Range(Cells(Dest_Start_Row, 9), Cells(Dest_End_Row_2, 8 + Num_Months))
.PasteSpecial 8 ' Column width
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'(3.) INSERT COLUMN HEADERS FOR CUSTOM FIELDS
N = Sheets("Pricing").Range("$I$23")
With Sheets("Res Hrs Cost-PP")
.Columns("C").Resize(, N).Insert
Sheets("Pricing").Range("$E$9:$E" & 9 + N - 1).Copy
.Range("C1").PasteSpecial Paste:=xlValues, Transpose:=True
Application.CutCopyMode = False
End With
'(4.) COPY DATA FOR CUSTOM FIELDS FROM THE "STAFFING PLAN" WORKSHEET
On Error Resume Next
For C = Column_C To 2 Step -1
'IF THERE ARE CUSTOM FIELDS....
If Cells(1, C).Value = "Burden Pool ID" And Cells(1, C - 1).Value <> "Resource ID" Then
'THEN....
'INSERT CODE THAT LOOKS AT THE COLUMN HEADERS FOR THE CUSTOM FIELDS, AND CHECKS IF THIS COLUMN HEADER CAN BE FOUND IN ROW 13 OF THE "STAFFING PLAN" WORKSHEET... IF IT CAN BE FOUND, THEN COPY THAT COLUMN FROM ROW 14 TO "Dest_End_Row_2" - DEFINED IN STEP 2 FIELD 2 - ONTO THE "IMPORT" WORKSHEET
End If
Next C
On Error GoTo 0
End Sub
