Help with format tweaking of existing code (date and text)

[Serafin54]

Hello,

I have a code that will look at the current sheet and then combine amounts found under identical headers.

While it works really well, I need to tweak it due to recently discovered issues. For instance, the employee badge might contain leading zeros and when the code runs, the zeros drop. I added in a code at the front end to update the sheet to text but when i do that, the dates obviously also follow and become serial numbers. I have tried to tweak the " Cells(1, 1 + col).Resize(rc, 1).Value = SD.items()(col)" but anything i try causes the code to clear all cells.

Basically, what i'm trying to accomplish is to:
1. Update all cells to text unless there is a "/" or is already formatted as date (whichever is easiest to code)
2. Auto size all columns so that i don't get a scientific reference. Not that i have, but more as precaution.

Thanks for looking.


Before:

Employee Badge	Employee Name	Date	Apples	Oranges	Bananas	Apples	Plums
0012	Jon Smith	01/01/2022	10	34	88	50	90
0014	Betty White	01/02/2022	6	30	76	33	57
1234	Axel Foley	01/03/2022	7	11	70	61	2
765	Nigel Tufnell	01/04/2022	6	25	25	57	81
00001	Hans Gruber	01/05/2022	6	87	68	94	79

After:

Employee Badge	Employee Name	Date	Apples	Oranges	Bananas	Plums
0012	Jon Smith	44562	60	34	88	90
0014	Betty White	44563	39	30	76	57
1234	Axel Foley	44564	68	11	70	2
765	Nigel Tufnell	44565	63	25	25	81
00001	Hans Gruber	44566	100	87	68	79

Sub Combine_Duplicate_Headers_formatting()

'Sums amounts under duplicate headers
Dim r As Range:         Set r = Range("A1").CurrentRegion
Dim rc As Integer:      rc = r.Rows.Count
Dim AR() As Variant:    AR = r.Value2
Dim SD As Object:       Set SD = CreateObject("Scripting.Dictionary")
Dim v As Variant

'changes formats to text prior to combine so that leading zeros aren't dropped if left as general format
With r
    .NumberFormat = "@"
    .Value = .Formula
End With

For i = 1 To UBound(AR, 2)
    If Not SD.exists(AR(1, i)) Then
        SD.Add AR(1, i), Application.Index(AR, 0, i)
    Else
        v = SD(AR(1, i))
        For j = 2 To UBound(v)
            v(j, 1) = v(j, 1) + AR(j, i)
        Next j
        SD(AR(1, i)) = v
    End If
Next i

r.ClearContents

For col = 0 To SD.Count - 1
    Cells(1, 1 + col).Resize(rc, 1).Value = SD.items()(col)
Next col
  For rc = 1 To ActiveSheet.UsedRange.Columns.Count
  
Next
End Sub

 

[johnnyL]

Change:

    .NumberFormat = "@"

to:

    .Columns("A:A").NumberFormat = "@"

 

[Serafin54]

Change:

    .NumberFormat = "@"

to:

    .Columns("A:A").NumberFormat = "@"

Thank you and while that works, it only does so if the id number is always in A.

I am looking to see if there is a more general way to address this so when another layout of the report is supplied, it can be ran with the ID number in D, for example and Date in Column A. In my approach, the entire dataset would be changed to a Text format except if the cell contains a "/" or is set as date. There might even be times where a report has an order date and a sold date and could have delivered date among a few others. So looking to have this as a swiss army knife of sorts.

 

[johnnyL]

Is the employee badge column always going to be labeled 'Employee Badge' ?

 

[Serafin54]

it won't unfortunately. Depending on the system the report generates from it could be Employee ID or it could also be from our accounting system that for some god awful reason, lets the user name the field so not only could it be different but also misspelled. This is why i was trying to change all with an exception instead. Same with the date field. it can be named something else but the "/" will always be present.

 

[johnnyL]

How about replacing:

With r
    .NumberFormat = "@"
    .Value = .Formula
End With

with:

Dim cel As Range
    For Each cel In r
        If Not IsDate(cel.Value) Then
            cel.NumberFormat = "@"
            cel.Value = cel.Formula
        End If
    Next

 

[Serafin54]

That's it. So the line is looking for anything that isn't a date rather than looking for what is a date. ok that works well actually. thank you.

 

[johnnyL]

Correct. If a cell is not considered a date then you want to make it a text cell.

Glad to help.

 

[Serafin54]

Correct. If a cell is not considered a date then you want to make it a text cell.

Glad to help.

It takes quite a while to run and sometimes locks up. Should that be expected?

 

[johnnyL]

How many rows & columns do you have?