I have a defined header string that I am trying to locate the respective column number for in a table. The table headers titles formats are indented with Alt+Enter.
The code works fine if the header string is written normally (without indentation)
Sample: Origin_Country(in 2-letter codes)
In the excel table however the header format is different as mentioned.
sample:
Origin_
Country
(in 2 letter format)
Excel seems to think there is a space in the header due to the indentation and it is not recognized.
Did anyone encounter this and know a work around?
Option Compare Text
Option Explicit
Sub ListChanges()
Dim arrOrig, arrCurrent, delta, i As Long, ii As Long, r As Long, m
Dim rngOrig As Range, rngCurrent As Range, id, col As Long, vO, vC
Dim ls As String
Dim HeaderName As String, HeaderRow As Long
Dim j As Long
Dim LastRow As Long, LastCol As Long, RowProcess As Long
Dim TopLeftAddress As String
'Origin Country
Dim OCountryCol As Long
Dim strOCountryCol As String
'DGF Lane ID
Dim DGFLaneIDCol As Long
Dim strDGFLaneIDCol As String
'Origin Region
Dim ORegionCol As Long
Dim strORegionCol As String
'------
Dim ActSht As Worksheet
Set ActSht = Worksheets(2)
'ActiveWorkbook.Sheets(General).Range ("1:1")
TopLeftAddress = ActSht.Range("1:1").Address 'identify top left cell of the table, to see where the table starts
LastCol = ActSht.Range(TopLeftAddress).End(xlToRight).Column ' total number of columns in each pivot table
i = ActSht.Range(TopLeftAddress).Column 'column number where the table starts
HeaderRow = ActSht.Range("1:1").Row 'row number where the table starts
For j = 25 To LastCol 'i set j at 25 so that I don't have to loop through all columns
HeaderName = ActSht.Cells(HeaderRow, j)
If InStr(HeaderName, "Origin_Country(in 2-letter codes)") > 0 Then
OCountryCol = j
strOCountryCol = Split(ActSht.Cells(, OCountryCol).Address, "$")(1)
ElseIf InStr(HeaderName, "Origin_Region(enter AP, AM, EURO, MEA)") > 0 Then
ORegionCol = j
strORegionCol = Split(ActSht.Cells(, ORegionCol).Address, "$")(1)
End If
Next
Set rngOrig = Original.Cells(1).CurrentRegion
Set rngCurrent = Current.Cells(1).CurrentRegion
arrOrig = rngOrig.Value
arrCurrent = rngCurrent.Value
ReDim delta(1 To UBound(arrCurrent, 1) * (UBound(arrCurrent, 2)), 1 To 8) 'max possible size
delta(1, 1) = "Location"
delta(1, 2) = "Original Value"
delta(1, 3) = "Changed Value"
delta(1, 4) = "Deviation"
delta(1, 5) = "Header"
delta(1, 6) = "Row ID"
delta(1, 7) = "Origin Region"
delta(1, 8) = "Origin Country"
r = 1 'row in delta array
For i = 2 To UBound(arrCurrent, 1)
id = arrCurrent(i, 1)
'find the corresponding row
m = Application.Match(id, rngOrig.Columns(1), 0)
If Not IsError(m) Then
For col = 2 To UBound(arrCurrent, 2)
vO = arrOrig(m, col)
vC = arrCurrent(i, col)
If (Len(vC) > 0 Or Len(vO) > 0) And vC <> vO Then
r = r + 1
delta(r, 1) = rngCurrent.Cells(i, col).Address(False, False)
delta(r, 2) = vO
delta(r, 3) = vC
If Len(vO) > 0 And Len(vC) > 0 Then
If IsNumeric(vO) And IsNumeric(vC) Then
delta(r, 4) = vC / vO - 1 'eg
End If
End If
delta(r, 5) = arrCurrent(1, col) 'header
delta(r, 6) = arrCurrent(i, 1) 'id
delta(r, 7) = arrCurrent(i, 26) 'id region
delta(r, 8) = arrCurrent(i, 27) 'id country
End If
Next col
Else
'no id match, just record the cell address and the current id
r = r + 1
delta(r, 1) = rngCurrent.Cells(i, 1).Address(False, False)
delta(r, 6) = id
End If
Next
With Changes
.Activate
.Cells(1).CurrentRegion.Clear
.[a1].Resize(r, UBound(delta, 2)) = delta '<< edited here
With .Cells(1).CurrentRegion
.HorizontalAlignment = xlCenter
With Rows(1).Font
.Size = 12
.Bold = 1
End With
.Columns.AutoFit
End With
End With
End Sub