Get column header from 1 sheet & compare rows with another sheet

[Sugibala]

Hi

can any one help me in getting the below scenario.

i have 2 sheets in excel. sheet 1 with data. sheet2 has column headers as reference in column B2
i want to take column headers from sheet1 . Iterate through sheet2 (column 2) .If my header value matches then take the B3 value from sheet 2.It can b M(Mandatory field check), B(Boolean value check) and so on..
I have the code snippet for doing the check operations but it is hardcoded with the columnname which i want to be dynamic (retrieve the column cell based on matching column header) .

And i also struggle to get the header and find it in sheet2. can any of u help. I am attaching the 2 excel sheet and code

in the attached sheets, sheet1 finds the header in sheet2 of any order, then it takes the value M/B. in my sheet1, lastname row5 s empty which has to be highlighted since its mandate.the same way for country.

Dim intResult As Integer
Dim Data_sh1 As Worksheet, User_Details_sh2 As Worksheet
Dim Data_Lr As Long, User_Details_lr As Long, lc As Long, lc1 As Long, i As Long, j As Long
 
Dim a() As Variant, b() As Variant


Set Data_sh1 = Sheets("Service User") 'origin


Set User_Details_sh2 = Sheets("User Details")  'destination




'last row on origin sheet


Data_Lr = Data_sh1.Range("A" & Rows.Count).End(xlUp).Row


'last row on destination sheet


User_Details_lr = User_Details_sh2.Range("A" & Rows.Count).End(xlUp).Row + 1




'Store headers in the "a" variable of the origin sheet


lc = Data_sh1.Cells(1, Columns.Count).End(xlToLeft).Column


a = WorksheetFunction.Transpose(Data_sh1.Range("A1", Data_sh1.Cells(1, lc)).Value)
 
 'Store headers in the "b" variable of the destination sheet


lc1 = User_Details_sh2.Range("B" & Rows.Count).End(xlUp).Row
 


b = WorksheetFunction.Transpose(User_Details_sh2.Range("B2", User_Details_sh2.Cells(1, lc1)).Value)
 
 MsgBox lc
 
Dim TimeZone_i As Integer
Dim TimeZone_rng As Range
 Dim Picklist_TimeZone As Long


 With Data_sh1
    For TimeZone_i = 1 To .Range("A1").SpecialCells(xlCellTypeLastCell).Column
     
        Set TimeZone_rng = .Range("A1:A" & TimeZone_i)
        If WorksheetFunction.CountIf(User_Details_sh2.Range("B:B"), TimeZone_rng) = 0 Then 'picklist reference sheet column E
            MsgBox User_Details_sh2.Range("B:B").Cells.Value
            Picklist_TimeZone = Picklist_TimeZone + 1
        Else
            TimeZone_rng.Interior.Color = vbWhite


        End If
    Next
End With

individual mandatory check code hardcoded with column cell .which i want dynamic too

''Get the last row of a sheet
'LR = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
'
'Dim External_ID_i As Long
'Dim External_ID_c As Long
'Dim External_ID_myRange As Range
'Dim External_ID_myCell As Range
'Dim MyList(2) As String ' create array with definite size and value
'MyList(0) = "Open" ' assign value
'MyList(1) = "Closed"
'
'Set External_ID_myRange = Range("A1:A" & LR)
'
'For Each External_ID_myCell In External_ID_myRange '
'     External_ID_c = External_ID_c + 1
'    If IsEmpty(External_ID_myCell) Then
'        External_ID_myCell.Interior.Color = RGB(255, 87, 87)
'        External_ID_i = External_ID_i + 1
'
'    Else
'        External_ID_myCell.Interior.Color = vbWhite
'    End If
'
'
'Next External_ID_myCell
'
'If External_ID_i > 0 Then
'MsgBox _
'"External ID (Column A) : There are total " & External_ID_i & " empty cells out of " & External_ID_c & ".Input a Number."
'

generic_sheet2.jpggeneric_sheet1.jpg

[arnelgp]

can you share a workbook with sample data (sheet1) and expected result on sheet2?

[Sugibala]

Hey Arnel..Glad to see you back, i am hoping to a lot now. I could attach only the images of the workbook (expected result in sheet1 with red color highlighted )generic_sheet1.jpggeneric_sheet2.jpg will this help?

[arnelgp]

a "real" workbook not image (it is small to view).
you can put it in dropbox/onedrive if you cannot attached it.
put the link to the file back here.

[Sugibala]

https://www.dropbox.com/home?preview=Smple_Generic.xlsx
can you check in this link?

[Sugibala]

https://www.dropbox.com/home?preview=Smple_Generic.xlsx
can you check in this link?

[Sugibala]

HI Arnel, I have tried with a code to identify the headers presence in sheet2 of column 2. Is there any way you can suggest to get corresponding c3 value

Option Explicit


Private Sub Workbook_AfterSave(ByVal Success As Boolean)


  
 
    
Dim SourceSheet As Worksheet    'The data to be copied is here
Dim TargetSheet As Worksheet    'The data will be copied here
Dim ColHeaders As Range         'Column headers on Target sheet
Dim MyDataHeaders As Range      'Column headers on Source sheet
Dim DataBlock As Range          'A single column of data
Dim c As Range                  'a single cell
Dim Rng As Range                'The data will be copied here (="Place holder" for the first data cell)
'Dim i As Integer


Dim MyRow As Integer
    Dim MyCol As Integer
    


Dim check_type As String
'Change the names to match your sheetnames:
Set SourceSheet = Sheets("Service User") 'sheet1
Set TargetSheet = Sheets("User Details") 'sheet2




With TargetSheet
'    Set ColHeaders = .Range(.Cells(2, 2), .Cells(1, .Columns.Count).End(xlToLeft)) 'Or just .Range("A1:C1")
'    Set Rng = .Cells(.Rows.Count, 2).End(xlUp).Offset(1) 'Shoots up from the bottom of the sheet untill it bumps into something and steps one down
  Set ColHeaders = .Range("B2:B26") ' .Range(.Cells(1, 1), .Cells(1, .Rows.Count).End(xlToLeft)) 'Or just .Range("A1:C1")
    Set Rng = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)


End With


With SourceSheet
    Set MyDataHeaders = .Range("A1:AB1")
   End With
'Makes sure all the column names are the same:
'Each header in Source sheet must have a match on Target sheet (but not necessarily in the same order + there can be more columns in Target sheet)
    For Each c In MyDataHeaders
        If Application.WorksheetFunction.CountIf(ColHeaders, c.Value) <> 0 Then
'                  check_type = TargetSheet.Cells(c, 3).Value
'          check_type = Worksheets("User Details").Cells(c.Row, "C3").Value
          
'         MsgBox check_type
         
'         MyRow = Worksheets("User Details").Range(c.EntireRow.Rows).Value
'    MyCol = Worksheets("User Details").Range("C3").Value
'  MsgBox Worksheets("User Details").Cells(MyRow, MyCol).Select
    c.Interior.Color = vbRed
   
            MsgBox _
            "found a matching header name for " & c.Value & vbNewLine & "Make sure the column names are the same and try again."
                 'The code exits here if thereäs no match for the column header
        End If
    Next c




End If




 
  
End Sub

[DaDoc]

hi Sugibala,
maybe this code helps you get closer to your solution:

Sub Main()
 Dim oWS_Target As Worksheet
 Dim oWS_Source As Worksheet
 Dim rg_Target As Range
 Dim rg_Found As Range
 Dim sSrchItem As String
  On Error Resume Next
  Set oWS_Source = ThisWorkbook.Sheets(1)
  Set oWS_Target = ThisWorkbook.Sheets(2)
  Set rg_Target = oWS_Target.Columns(2).UsedRange
  
  sSrchItem = "country"   'just an example - get your sSearchItem from where ever you need to
  Set rg_Found = rg_Target.Find(sSrchItem).Offset(0, 1)
  If Not rg_Found Is Nothing Then
    MsgBox " found " & sSrchItem & ". your value is in " & _
           oWS_Target.Name & " Cell " & rg_Found.Address
  Else
    MsgBox "no match with " & sSrchItem
  End If
  Set rg_Found = Nothing
  Set rg_Target = Nothing
  Set oWS_Source = Nothing
  Set oWS_Target = Nothing
  On Error GoTo 0
End Sub