Check two columns value and add them into Rows

[excel_kal]

Hi All,

I need to check the values in multiple columns and if the data is there then need to add them in Rows in Diff sheet. Below is the example data set and expected. I have tried with Index & match still not able to get the expected result. Any suggestions will be helpful.

Thanks
kal

 

[DanteAmor]

Hi and welcome to MrExce.

Libro1
	A	B	C	D	E	F	G	H	I	J	K
1	Customer	30 day date	30 day id	60 day Date	60 day id	90 day date	90 day id	misc1 date	misc1 id	misc2 date	misc2 id
2	Name 1	05-jun	123	06-jul	345
3	Name 2							06-jun	657
4	Name 3	10-jun	789					12-jun	890
5	Name 1							10-jun	432
6	Name 5					20-jul	987
Data Set

Assuming your data starts in cell A1 on the "Data Set" sheet.
The results on the "Result" sheet.
Adjust the names of your sheets in the macro.

Sub Check_two_columns()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, lr As Long, lc As Long
 
  With Sheets("Data Set")
    lr = .Range("A" & Rows.Count).End(3).Row
    lc = .Cells(1, Columns.Count).End(1).Column
    a = .Range("A1", .Cells(lr, lc)).Value2
  End With
  ReDim b(1 To lr * lc, 1 To 3)
 
  For i = 2 To UBound(a, 1)
    For j = 2 To UBound(a, 2) Step 2
      If a(i, j) <> "" Then
        k = k + 1
        b(k, 1) = Replace(a(1, j), "date", "", , , vbTextCompare)
        b(k, 2) = a(i, j)
        b(k, 3) = a(i, j + 1)
      End If
    Next j
  Next i
    
  Sheets("Result").Range("A2").Resize(k, 3).Value = b
End Sub

_______________________________________________________________________________

If there is not a lot of data, you can also try this macro, it is smaller.

Sub Check_two_columns_1()
  Dim i As Long, j As Long
  
  With Sheets("Data Set")
    For i = 2 To .Range("A" & Rows.Count).End(3).Row
      For j = 2 To .Cells(1, Columns.Count).End(1).Column Step 2
        If .Cells(i, j) <> "" Then
          Sheets("Result").Range("A" & Rows.Count).End(3)(2).Resize(1, 3).Value = _
          Array(.Cells(1, j), .Cells(i, j), .Cells(i, j + 1))
        End If
      Next j
    Next i
  End With
End Sub

 

[excel_kal]

Hi Danteamor,

Thanks for the quick reply. What if I have one more column added in the data set.

Thank,
Kal

 

[DanteAmor]

What is the result according to your new example.

 

[excel_kal]

Same Result as before only change is dataset has additional column in btw .

 

[DanteAmor]

Same Result as before only change is dataset has additional column in btw .

So the macro should jump the columns with the text value?

 

[excel_kal]

Yes .. Same result as below. Still I need the result from same Column as I mentioned first but the data set changed with additional columns. I was not sure what changes to be done to skip the column and get desired result

 

[DanteAmor]

Try this

Sub Check_two_columns_1()
  Dim i As Long, j As Long
  
  With Sheets("Data Set")
    For i = 2 To .Range("A" & Rows.Count).End(3).Row
      For j = 3 To .Cells(1, Columns.Count).End(1).Column Step 3
        If .Cells(i, j) <> "" Then
          Sheets("Result").Range("A" & Rows.Count).End(3)(2).Resize(1, 3).Value = _
          Array(.Cells(1, j), .Cells(i, j), .Cells(i, j + 1))
        End If
      Next j
    Next i
  End With
End Sub

 

[excel_kal]

Thanks a lot !! it worked

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.