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."
'


2892628927

[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 )2892828929 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