根据单元格计数和 header 值插入指定文本字符串 X 次

Question

UPDATED - Screenshots added / tables added

Newbie to VBA here, so apologies as I am sure this is a simple task but have researched and tested to no avail.

I am trying to re-format a standard report into a new file format for uploading. I am trying to insert a text value X amount of times based on a header value. Each column header differs (Dependent Care; Medical FSA; HSA), but must be spelled out as "Dependent Care FSA" or "Health Savings Plan" etc. and must run X amount of times down the same column (Column E) on a different sheet.

Here is a piece of the code I have written for this section so far, but can't seem to continuously find the last row of what was just inserted and continue to run down the column. The number of instances will vary week after week so want this to be dynamic. The column headers and values continue to go down from E1 to J1. The number of values are all the same, but those are what changes week after week. There may be 334 rows one week and 340 the next.

NumToRepeat = wksSource.Range("C" & Rows.Count).End(xlUp).Row

    If wksSource.Range("E1").Value = "Pre_Tax_FSA_Dependent_care(DR1)" And wksSource.Range("F1").Value = "Pre_Tax_FSA_Medical(DR1)" Then
                   
        wksDest.Range("E2").Select
        ActiveCell.FormulaR1C1 = "Dependent Care FSA"
        wksDest.Range("E2").Select
        Selection.AutoFill Destination:=wksDest.Range("E2:E" & NumToRepeat)

        wksDest.Range("E" & Cells(Rows.Count, "E").End(xlUp).Row + 1).Select
        ActiveCell.FormulaR1C1 = "Medical FSA"
        wksDest.Range("E" & Cells(Rows.Count, "E").End(xlUp).Row + 1).Select
        Selection.AutoFill Destination:=wksDest.Range("E" & NumToRepeat + 1, "E" & NumToRepeat * 2 - 1)
                   
    End If
    
End With

I can get these two to stack up, but can't get others to stack thereafter. Whatever I write just copies over the second instance...

I just need HELP to continuously find the last row and pasting the text based on what is in the column headers. I apologize if this is all confusing (and elementary) but happy to clarify further and truly appreciate all the help in advance!!

Source Data Example

End Result Example

Here they are in table form: Source Table Data Sample

Paydate	EE_Code	SSN	EE Name	DepCareFSA	FSAMed	HSAemp	HSAer	Parking	Commuter
05/14/2021	ABCD	123456789	JOHN DOE	208.33	0	0	0	0	0
05/14/2021	EFGH	111111111	JANE DOE	0	0	0	38.46	0	0
05/14/2021	IJKL	222222222	JERRY DOE	0	0	0	38.46	0	0
05/14/2021	MNOP	333333333	JILL DOE	115.38	0	190.38	86.54	0	0
05/14/2021	QRST	444444444	JIM DOE	0	0	190.38	86.54	0	0
05/14/2021	UVWX	555555555	JEN DOE	0	0	100	38.46	0	0

Trying to re-format to this... conditional based on what column the values are coming from to fill in column C and column E with column F being standard "Current" all the way down through all rows.

EmployeeIdentifier	ContributionDate	ContributionDescription	ContributionAmount	PlanName	PriorTaxYear
123456789	05142021	Payroll	208.33	Dependent Care FSA	Current
111111111	05142021	Payroll	0	Dependent Care FSA	Current
222222222	05142021	Payroll	0	Dependent Care FSA	Current
333333333	05142021	Payroll	115.38	Dependent Care FSA	Current
444444444	05142021	Payroll	0	Dependent Care FSA	Current
555555555	05142021	Payroll	0	Dependent Care FSA	Current

This would continue on with values from column E, followed by column F stacked underneath, and so on and so forth with the corresponding contribution type listed based on which column it came from.

I am able to get everything setup (repeated SSN down the column, repeated dates... although in the incorrect format, corresponding values), but cannot figure out how to get the dependent names for column C and E to continuously find the last row, stack on top of each other while corresponding to the correct SSN and value... I haven't tried adding the column F where it says "current" all the way down but figure that's pretty easy?

Any and all help is truly appreciated. I am a proficient Excel user, but new to VBA and have been scouring to figure this all out. I am about 75% of the way there, but need help with these steps...

Thank you!

Answer 1

Here's the solution for your case. Tune sheets' names to ones you need. The helper SetTags function merely selects appropriate names based on header's value. It uses ByRef in order to change these variables directly (and not use function which would return array). Before calling SetTags we need to clear these variables - this will give us a chance to catch an error if you misspell some text in SetTags (in this case there will be empty cells on the final worksheet). If we don't clear them and you have misspelled some text, you will get wrong text on the final worksheet. Also code uses two ranges - one with header ( rngTable ) and one without header ( rngData ). rngData lets us easily transfer data to final worksheet without any further calculations. Finally, since we know that the number of rows being copied is always the same, the next row (to insert to on the final worksheet) is calculated as current next row plus this number of rows.

Option Explicit

Sub Transfer()

    Dim wksSource As Worksheet, wksDest As Worksheet
    Dim rngTable As Range, rngData As Range
    Dim rowsCount&, nextRow&, col&
    Dim strContribDesc$, strPlanName$
    
    Set wksSource = Worksheets("SOURCE SAMPLE")
    Set wksDest = Worksheets("FINAL")
    Set rngTable = wksSource.Range("A1").CurrentRegion
    With rngTable: Set rngData = .Offset(1).Resize(.Rows.Count - 1): End With
    nextRow = 2: rowsCount = rngData.Rows.Count
    
    With wksDest
        .[A1].CurrentRegion.Offset(1).EntireRow.Delete '//Delete old data
        For col = 5 To 10
            strContribDesc = vbNullString: strPlanName = vbNullString
            Call SetTags(rngTable.Rows(1).Cells(col), strContribDesc, strPlanName)
            .Cells(nextRow, "A").Resize(rowsCount).Value = rngData.Columns(3).Value   '//EmployeeIdentifier
            .Cells(nextRow, "B").Resize(rowsCount).Value = rngData.Columns(1).Value   '//ContributionDate
            .Cells(nextRow, "C").Resize(rowsCount).Value = strContribDesc             '//ContributionDescription
            .Cells(nextRow, "D").Resize(rowsCount).Value = rngData.Columns(col).Value '//ContributionAmount
            .Cells(nextRow, "E").Resize(rowsCount).Value = strPlanName                '//PlanName
            .Cells(nextRow, "F").Resize(rowsCount).Value = "Current"                  '//PriorTaxYear
            nextRow = nextRow + rowsCount
        Next
    End With
    
    MsgBox "Well done!", vbInformation

End Sub

Private Sub SetTags(strHeader$, ByRef strContribDesc$, ByRef strPlanName$)
    Select Case strHeader
        Case "Pre_Tax_FSA_Dependent_care(DR1)"
            strContribDesc = "Payroll"
            strPlanName = "Dependent Care FSA"
        Case "Pre_Tax_FSA_Medical(DR1)"
            strContribDesc = "Payroll"
            strPlanName = "Medical FSA"
        Case "Pre_Tax_HSA_Employee(DR1)"
            strContribDesc = "Payroll"
            strPlanName = "Health Savings Plan"
        Case "Pre_Tax_HSA_Employer(DR1)"
            strContribDesc = "Employer"
            strPlanName = "Health Savings Plan"
        Case "Parking_Benefit(DR1)"
            strContribDesc = "Payroll"
            strPlanName = "Parking"
        Case "Commuter_Benefit(DR1)"
            strContribDesc = "Payroll"
            strPlanName = "Parking"
    End Select
End Sub