VBA - Age Calculations - Clear data and Recalculate

[snuffnchess]

[CODE]

[/CODE]I am working on a sheet that will have columns

Name 1, DOB 1, Age 1, Relationship 1, Name 2, DOB 2, Age 2..... up to 24 total.

Info will be entered with a Userform.... and not every row will be filled with 24 people

Form Uses the following code for each of the people

'Adult 1    ws.Cells(newRow, 21).Value = TextBox12.Text & " " & TextBox13.Text ' 12 is First Name, 13 Last Name
    ws.Cells(newRow, 22).Value = Format(TextBox14.Text, "MM/DD/YYYY") ' DOB
    If ws.Cells(newRow, 22).Value <> "" Then                                           ' If DOB is not blank then calculate age
       ws.Cells(newRow, 23).Value = WorksheetFunction.RoundDown(WorksheetFunction.YearFrac(ws.Cells(newRow, 22), Now), 0)
    End If
    ws.Cells(newRow, 24).Value = relat1.Text ' Relationship to client
        If CheckBox2.Value Then                      ' Has the information been verified... yes/no radio button
        ws.Cells(newRow, 25).Value = "yes" 
        End If
    If CheckBox3.Value Then
        ws.Cells(newRow, 25).Value = "no"
        End If

I am trying to avoid having formulas in the worksheet itself as I am afraid of people breaking them (I am doing this as a volunteer and will nto be a part of the organization to help fix it).

So What I am wanting to do is to have a macro that runs when the workbook is opened to update the current ages of the clients.

So it would need to clear the contents (Minus the header) from the columns with the word "Age" in the header... and then repopulate those columns with the current ages.

I have been playing around with VBA to do this... but cannot figure out how to offset the clearing of cells by the header row.

Sub ClearAge()
    Dim A As Range
    
    Do
        Set A = Rows(1).Find(What:="Age", LookIn:=xlValues, lookat:=xlPart)
        If A Is Nothing Then Exit Do
             
               
        
        A.EntireColumn.Clear
          
        
    Loop
End Sub

Once that is figured out then will need to repopulate it with Ages.

Help!

 

[JustynaMK]

Hi,

Hopefully this code will help - I introduced lngLastRow which helped me identify the last row in Sheet1 (change the sheet code if necessary), so that I can clear the data for rows 2 to lngLastRow (ignoring the Header in row 1). There's also lngColumn counter which allows you to look for "Age" header in row 1, minus columns that already have been cleared.

Sub ClearAge()
    Dim A                   As Range
    Dim lngLastRow          As Long
    Dim lngColumn           As Long
    
    lngLastRow = [COLOR=#ff0000]Sheet1[/COLOR].Cells([COLOR=#ff0000]Sheet1[/COLOR].Rows.Count, "A").End(xlUp).Row
    lngColumn = 1
    
    Do
        Set A = Range(Cells(1, lngColumn), Cells(1, 24)).Find(What:="Age", LookIn:=xlValues, lookat:=xlPart)
        If A Is Nothing Then
            Exit Do
        Else
            Range(Cells(2, A.Column), Cells(lngLastRow, A.Column)).Clear
            lngColumn = A.Column + 1
        End If
    Loop
End Sub

Best regards,
Justyna