Results 1 to 8 of 8

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

  1. #1
    VBAX Regular
    Aug 2021

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


    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
                TimeZone_rng.Interior.Color = vbWhite
            End If
    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."

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

  3. #3
    VBAX Regular
    Aug 2021
    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?

  4. #4
    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.

  5. #5

  6. #6
    VBAX Regular
    Aug 2021
    Quote Originally Posted by Sugibala View Post

  7. #7
    VBAX Regular
    Aug 2021
    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

  8. #8
    VBAX Newbie
    Dec 2021
    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
        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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts