Build HTML Table based on Loop through Excel Worksheet Column / Row condition

[mystik5]

I have a pretty big flat table in Excel, about 50 columns long. Within that flat table there are many values but one column in particular I want to sort by. For this sort, let's say the column is column 48 and I want to sort the order of descending. With the sort in hand, I want to then create an html table that will do the following:

1. depending on how many rows in the Excel file are carry the same value, aka a grouping of sorts, I want to loop through each row and add in the flat table, pull out certain values, write it as a html row in the table, then read the next row, if it carries the same value as the row above and if not, then to move to the next grouping.
For example: Column 48 row 2 = Fun, Column 48, row 3 = fun, Column 48 row 4 = fun, Column 48 row 5 = Ice Cream, Column 48 row 6 = Ice Cream, Column 48 row 7 = Pizza, Column 48 row 8 = Pizza.
1.A (i have reference below in the code for 1.A where i want this loop / table to play out) This would create an html table that writes 3 table rows worth of data into the html then stops and then loops to the next grouping which would be ice cream, creates the 2 table rows in a new html table and on it goes for wherever there is a grouping.

If the next row in column 48 is null then build a single row into an html table with data from the row.

Here is what i have so far, also please forgive the lack of grace with this code, i am very new to VBA so my way of writting is very crude at the moment, hopefully more graceful / better in time! I have redacted a lot so if the variables do not match that is on purpose.

Thanks for any help anyone can provide / guide me in the direction of resolution.

Sub Calendar_Invite()

Worksheets("2022_Details").Activate
Range("A2").Select

Dim emailTo, arch, baseline_ver, client_name As String
Dim city, country, region, username, Group_Together, Team_Member As String
Dim C1_1, C1_2, C1_3, C1_4, C2_1, C2_2, c2_3, C2_6, C2_7, C2_10, C3_1, C4_1, C5_1, C5_2, C5_4, C6_1, C6_2, C6_3, C6_4, C7_1, C7_2 As String
Dim C1_1_C, C1_2_C, C1_3_C, C1_4_C, C2_1_C, C2_2_C, c2_3_C, C2_6_C, C2_7_C, C2_10_C, C3_1_C, C4_1_C, C5_1_C, C5_2_C, C5_4_C, C6_1_C, C6_2_C, C6_3_C, C6_4_C, C7_1_C, C7_2_C As String

Dim x As Integer
'my sorting variables

Dim LC As Long, LR As Long, ii As Long

Interval = DateAdd("d", 11, Now)

Application.OnTime Interval, "testing"

lastrow = Cells(Rows.Count, 1).End(xlUp).Row

username = Application.username

Do Until IsEmpty(ActiveCell)

Dim olapp As Outlook.Application
Dim olMail As Object
Dim myTask As Outlook.TaskItem
Dim ollnsp As Inspector
Dim wddoc As Object
Dim oRng As Word.Range
Dim oBookmark As Object
Dim i As Long
Dim arr, months_of_year, days_of_month, f_years As Variant

Set olapp = New Outlook.Application
Set olMail = olapp.CreateItem(olMailItem)
Set myTask = olapp.CreateItem(olTaskItem)
Set appt = olapp.CreateItem(olAppointmentItem)

ID = ActiveCell.Offset(0, 0).Value
type = ActiveCell.Offset(0, 1).Value
name = ActiveCell.Offset(0, 2).Value
entity = ActiveCell.Offset(0, 3).Value
city = ActiveCell.Offset(0, 4).Value
country = ActiveCell.Offset(0, 5).Value
region = ActiveCell.Offset(0, 6).Value
rank = ActiveCell.Offset(0, 7).Value
type_a = ActiveCell.Offset(0, 8).Value
baseline_ver = ActiveCell.Offset(0, 9).Value
Provider_Name = ActiveCell.Offset(0, 10).Value
Provider_CODE = ActiveCell.Offset(0, 11).Value
Provider_Compliance = ActiveCell.Offset(0, 12).Value
Provider_Name2 = ActiveCell.Offset(0, 13).Value
Provider_Code2 = ActiveCell.Offset(0, 14).Value
Provider_Compliance2 = ActiveCell.Offset(0, 15).Value
C1_1 = ActiveCell.Offset(0, 16).Value
C1_2 = ActiveCell.Offset(0, 17).Value
C1_3 = ActiveCell.Offset(0, 18).Value
C1_4 = ActiveCell.Offset(0, 19).Value
C2_1 = ActiveCell.Offset(0, 20).Value
C2_2 = ActiveCell.Offset(0, 21).Value
c2_3 = ActiveCell.Offset(0, 22).Value
C2_6 = ActiveCell.Offset(0, 23).Value
C2_7 = ActiveCell.Offset(0, 24).Value
C2_10 = ActiveCell.Offset(0, 25).Value
C3_1 = ActiveCell.Offset(0, 26).Value
C4_1 = ActiveCell.Offset(0, 27).Value
C4_2 = ActiveCell.Offset(0, 28).Value
C5_1 = ActiveCell.Offset(0, 29).Value
C5_2 = ActiveCell.Offset(0, 30).Value
C5_4 = ActiveCell.Offset(0, 31).Value
C6_1 = ActiveCell.Offset(0, 32).Value
C6_2 = ActiveCell.Offset(0, 33).Value
C6_3 = ActiveCell.Offset(0, 34).Value
C6_4 = ActiveCell.Offset(0, 35).Value
C7_1 = ActiveCell.Offset(0, 36).Value
C7_2 = ActiveCell.Offset(0, 37).Value
l_rank = ActiveCell.Offset(0, 38).Value
Contacts = ActiveCell.Offset(0, 39).Value
Approved_By = ActiveCell.Offset(0, 40).Value
First_Name = ActiveCell.Offset(0, 41).Value
Last_Name = ActiveCell.Offset(0, 42).Value
Job_Title = ActiveCell.Offset(0, 43).Value
Phone_Number = ActiveCell.Offset(0, 44).Value
Email = ActiveCell.Offset(0, 45).Value
Company_Name = ActiveCell.Offset(0, 46).Value
Assessment_Date = ActiveCell.Offset(0, 47).Value
Group_Together = ActiveCell.Offset(0, 48).Value
Team_Member = ActiveCell.Offset(0, 49).Value

date_Sent = Now()

Tracking = WorksheetFunction.RandBetween(100, 9000000)

'sorting code

Call SortingSample ()


With olMail
Set ollnsp = .GetInspector
Set wddoc = ollnsp.WordEditor
Set oRng = wddoc.Range

' .Display
' .ReadReceiptRequested = True
' .SentOnBehalfOfName = "My teams group mail"
' .To = staff
'emailTo
'.CC = CCemail
' .BCC = BCCSender
' .Subject = "Testing email: " & client_name & " " & entity & " Tracking ID: " & Tracking
' .Importance = olImportanceHigh
' .FlagRequest = "Read"
' .FlagDueBy = DateAdd("d", 5, Date)
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML> <head></head>" & _
"<BODY><p><B>******INTERNAL******</b></p><br>Dear Team <br><br><p>Testing info is to help customers with program and objectives can be accessed " & "<a href="my mysite">here.</a> " & "<br>" & _
"<p>We are reaching out to you.... </p>" & _
"<table>" & _
"<style> table, th, td {border:1px solid black; border-collapse: collapse; margin-right: 25px}</style>" & _
"<tr><th bgcolor='blue' align='center' colspan='5' style=font-size:24px>CLIENT DETAILS</th></tr>" & _
"<tr><th align='left'>Client</th>" & "<th align='left'>City</th>" & "<th align='left'>Country</th>" & "<th align='left'>BIC Code</th>" & "<th align='left'>CID</th></tr>" & _
[B]'1.A this is where i want the code to loop based on the values of the grouping so it creates as many rows as needed otherwise just create the one row[/B]
"<tr><td align='left'>" & client_name & "</td>" & "<td>" & city & "</td>" & "<td>" & country & "</td>" & "<td>" & entityc & "</td>" & "<td>" & CID & "</td></tr>" & "</table>" & "<br>" & _
"<table><style><table, tr, th, td {border: 1px solid gray; border-collapse: collapse; margin-right: 10px}</style>" & _
"<th bgcolor='blue' align='center' colspan='2' style=font-size:24px>Required Meeting Attendees</th>" & "<tr><th align='left'>Lead Client Contacts</th><td>" & Contacts & "</td></tr>" & "<tr><th align='left'>Manager </th><td>Bob's Burgers</td></tr>" & "<tr><th align='left'>Operations:</th></tr>" & Team_Members & "</td></tr>" & "</table>" & _
"<br><br><p>Regards" & "</Body></HTML>"

With appt
.Display
.MeetingStatus = olMeeting
.RequiredAttendees = My team
.ReminderSet = True
.ReminderMinutesBeforeStart = 15
.Location = "My zoom"
.Duration = 30
.AllDayEvent = "False"
.Subject = "Testing email: " & client_name & " | " & city & " | " & entity 
End With

olMail.GetInspector().WordEditor.Range.FormattedText.Copy
appt.GetInspector().WordEditor.Range.FormattedText.Paste

ActiveCell.Offset(0, 50).Value = date_Sent

End With

ActiveCell.Offset(1, 0).Select

Loop

Set olMail = Nothing
Set olapp = Nothing
Set myTask = Nothing
Set ollnsp = Nothing
Set wddoc = Nothing
Set oRng = Nothing
Set oBookmark = Nothing

End Sub