Excel lookup function with VBA

[Goalexcel]

Hello Experts, Please advice, the best way, maybe with VBA, to track numbers with different colors.
In InputData(Sheet1) every time I input a number, should appear the same number colour format in Sheet2 , in order to track those numbers, the color need to change acording tracking # (K6), also, show in column K2 two positions, how many times occurs. Sheet2 no always will have the range A1:I101, it could be change the range.

Here link excel file.

Transfer - Dropbox

Dropbox is a free service that lets you bring your photos, docs, and videos anywhere and share them easily. Never email yourself a file again!

www.dropbox.com

 

[Zot]

I think many do not understand what you were trying to achieve to be able to suggest anything.

You input number in InputData sheet. You meant you type data in all 3 columns Hader1, Header2 and Header3?

Then you said should appear the same number colour format in Sheet2. Color to and from where? You have under tracking 3 colored cells that link to InputData sheet;
=InputData!A2
=InputData!A11
=InputData!A19

These are fixed formula? How it is related to InputData sheet. I see that the link is to 1st occurrence of unique number. Sheet2 also has sporadic yellow cell. Any relation to these 3 colored cell?

 

[Goalexcel]

I think many do not understand what you were trying to achieve to be able to suggest anything.

You input number in InputData sheet. You meant you type data in all 3 columns Hader1, Header2 and Header3?

Then you said should appear the same number colour format in Sheet2. Color to and from where? You have under tracking 3 colored cells that link to InputData sheet;
=InputData!A2
=InputData!A11
=InputData!A19

These are fixed formula? How it is related to InputData sheet. I see that the link is to 1st occurrence of unique number. Sheet2 also has sporadic yellow cell. Any relation to these 3 colored cell?

Thank you for your replay.
1.- I type data in 3 headers, sheet InputData, and will continue growing the range down.
2. - Sheet2, It's report summary, tracking and count how many times appear the number(Header 2) from InputData.
3. Inputdata, header1 is the Tracking number (reference) must have color cell in sheet2, every tracking number have many numbers=header 2,
4. Sheet2 is a desire report, tracking number=unique color=numbers in tha range A:I=header2(InputData)
5. I used formulas to avoid errors, is just only example.

 

[Goalexcel]

Hello Experts, Please advice, the best way, maybe with VBA, to track numbers with different colors.
In InputData(Sheet1) every time I input a number, should appear the same number colour format in Sheet2 , in order to track those numbers, the color need to change acording tracking # (K6), also, show in column K2 two positions, how many times occurs. Sheet2 no always will have the range A1:I101, it could be change the range.

Hello Experts, Please advice, the best way, maybe with VBA, to track numbers with different colors.
In InputData(Sheet1) every time I input a number, should appear the same number colour format in Sheet2 , in order to track those numbers, the color need to change acording tracking # (K6), also, show in column K2 two positions, how many times occurs. Sheet2 no always will have the range A1:I101, it could be change the range.

Here link excel file.

Transfer - Dropbox

Dropbox is a free service that lets you bring your photos, docs, and videos anywhere and share them easily. Never email yourself a file again!

www.dropbox.com

Hello Experts, Please bear with me. The excel file is for tracking the numbers in sheet1inputdata header2, those numbers must show color in sheet2 report with the header1=tracking number (sheet1 inputdata), What I'm asking to improve tracking, everything, the desired result sheet2=report, maybe with vba, easy on eyes, functionality, Thank you in advance.

 

[Zot]

Thank you for your replay.
1.- I type data in 3 headers, sheet InputData, and will continue growing the range down.
2. - Sheet2, It's report summary, tracking and count how many times appear the number(Header 2) from InputData.
3. Inputdata, header1 is the Tracking number (reference) must have color cell in sheet2, every tracking number have many numbers=header 2,
4. Sheet2 is a desire report, tracking number=unique color=numbers in tha range A:I=header2(InputData)
5. I used formulas to avoid errors, is just only example.

The list in Input Data will keep growing but would there be more number to be tracked instead of just 3 in sample (100372,100373,100374)? This number is manually entered or automatically?
The tracking number color in Summary is set by user?
The matching Headere2 number related to Header1 will be highlighted according to Tracking number in sheet Summary K6, K7, K8? The sample is not completely colored, right?
I cannot understand the number in Headers and Times (Summary K2:L3). Please explain.
What is the rest of header in sheet Summary from row 18 and above. Looks like repetition. To be used later?

 

[Goalexcel]

The list in Input Data will keep growing but would there be more number to be tracked instead of just 3 in sample (100372,100373,100374)? This number is manually entered or automatically?
The tracking number color in Summary is set by user?
The matching Headere2 number related to Header1 will be highlighted according to Tracking number in sheet Summary K6, K7, K8? The sample is not completely colored, right?
I cannot understand the number in Headers and Times (Summary K2:L3). Please explain.
What is the rest of header in sheet Summary from row 18 and above. Looks like repetition. To be used later?

Hello, Mr.Tot, thank you for your replay.
1. Yes, the list in sheet1=Input data will keep growing,the data is entered manually.
2. The color for tracking numbers and those number in the table need to show different color , they need to show all colors.
3. Matching number header2 and header1 will be highlighted according to tracking number in sheet summary, the sample is not complete colored, and will be growing according to sheer1 input data.
4. Range k2:L3, = header2= sheet input data, those 2 higher positions., and show how many time header2 is repeated.
5. The rest numbers row 18, is an example, but original those numbers will be different, and those number will be the same different entered in sheet input data header2, need to be Color with the tracking number,

 

[Zot]

Been busy lately and not much time to look at the worksheet.

I found that there are overlapped number like
100372 --- 80 --- East
100373 --- 80 --- North

If I were to highlight the 80, it is referring to 100372 or 100373 color?

 

[Goalexcel]

Been busy lately and not much time to look at the worksheet.

I found that there are overlapped number like
100372 --- 80 --- East
100373 --- 80 --- North

If I were to highlight the 80, it is referring to 100372 or 100373 color?

Thank you Mr. ZOT for your attention.
Any numbers will be a repeated, like 80, so then will be color again with the last tracking number 100373.

 

[Zot]

Check if this meet your requirement as I understood it. I put this under Worksheet1. I just patch here and there when writing code. Probably not really systematic ?

The code clear and refresh everything in the list. SO, either you key in one by one or copy paste a whole range to input list it does not matter.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rowTracking&, nCount&, rowCount&
Dim TrackNo As Range, cellTrack As Range, cellNumber As Range
Dim rngTrackingList As Range, TrackingFound As Range, NumberFound As Range
Dim rngAC As Range, rngNumber As Range, rngInput As Range, rngHeader As Range
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ActiveWorkbook.Sheets("InputData")
Set ws2 = ActiveWorkbook.Sheets("Sheet2")
Set rngAC = ws1.Range("A:C")

Set rngNumber = ws2.Range("A2", "I16")
Set rngTrackingList = ws2.Range("K2", "K" & ws2.Cells(ws2.Rows.Count, "K").End(xlUp).Row)

Application.ScreenUpdating = False
rngTrackingList.ClearContents

On Error Resume Next
If Not Intersect(Target, rngAC) Then
    If Application.WorksheetFunction.CountA(ws1.Range("A" & Target.Row, "C" & Target.Row)) = 3 Then
        Set rngInput = ws1.Range("A2", "A" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row + 1)
        Set rngTrackingList = ws2.Range("K2", "K" & ws2.Cells(ws2.Rows.Count, "K").End(xlUp).Row + 1)
        Set TrackingFound = rngTrackingList.Find(TrackNo.Value2)
        rngNumber.Interior.Color = xlNone
        rowCount = ws2.Cells(ws2.Rows.Count, "M").End(xlUp).Row
        ws2.Range("M2", "N" & rowCount + 1).ClearContents
        For Each TrackNo In rngInput
            Set TrackingFound = rngTrackingList.Find(TrackNo.Value2)
            If TrackingFound Is Nothing Then
                ws2.Range("K" & ws2.Cells(ws2.Rows.Count, "K").End(xlUp).Row + 1) = TrackNo.Value2
                Set rngTrackingList = ws2.Range("K2", "K" & ws2.Cells(ws2.Rows.Count, "K").End(xlUp).Row + 1)
            End If
        Next
        Set rngTrackingList = ws2.Range("K2", "K" & ws2.Cells(ws2.Rows.Count, "K").End(xlUp).Row)
        For Each TrackNo In rngInput
            Set TrackingFound = rngTrackingList.Find(TrackNo.Value2)
            For Each cellTrack In rngTrackingList
                For Each cellNumber In rngNumber
                    If cellNumber = TrackNo.Offset(0, 1) Then
                        cellNumber.Interior.Color = TrackingFound.Interior.Color
                    End If
                Next
            Next
        Next
    End If
    Set rngNumber = ws1.Range("B2", ws1.Cells(ws1.Rows.Count, "B").End(xlUp))
    For Each cellNumber In rngNumber
        Set rngHeader = ws2.Range("M2", "M" & ws2.Cells(ws2.Rows.Count, "M").End(xlUp).Row + 1)
        Set NumberFound = rngHeader.Find(cellNumber.Value2)
        If NumberFound Is Nothing Then
            nCount = Application.WorksheetFunction.CountIf(rngNumber, CStr(cellNumber))
            If nCount > 1 Then
                rowCount = ws2.Cells(ws2.Rows.Count, "M").End(xlUp).Row + 1
                ws2.Range("M" & rowCount) = cellNumber.Value2
                ws2.Range("N" & rowCount) = nCount
            End If
        End If
    Next
End If

End Sub

 

[Zot]

For got to tell you that I change the Header and Times to column M and N since you never know how many rows it is going down the list

Too late for minor adjustment. So, this is the latest code

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rowTracking&, nCount&, rowCount&
Dim TrackNo As Range, cellTrack As Range, cellNumber As Range
Dim rngTrackingList As Range, TrackingFound As Range, NumberFound As Range
Dim rngAC As Range, rngNumber As Range, rngInput As Range, rngHeader As Range
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ActiveWorkbook.Sheets("InputData")
Set ws2 = ActiveWorkbook.Sheets("Sheet2")
Set rngAC = ws1.Range("A:C")

Set rngNumber = ws2.Range("A2", "I16")
Set rngTrackingList = ws2.Range("K2", "K" & ws2.Cells(ws2.Rows.Count, "K").End(xlUp).Row + 1)

Application.ScreenUpdating = False
rngTrackingList.ClearContents

On Error Resume Next
If Not Intersect(Target, rngAC) Then
    If Application.WorksheetFunction.CountA(ws1.Range("A" & Target.Row, "C" & Target.Row)) = 3 Then
        Set rngInput = ws1.Range("A2", "A" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row + 1)
        Set rngTrackingList = ws2.Range("K2", "K" & ws2.Cells(ws2.Rows.Count, "K").End(xlUp).Row + 1)
        Set TrackingFound = rngTrackingList.Find(TrackNo.Value2)
        rngNumber.Interior.Color = xlNone
        rowCount = ws2.Cells(ws2.Rows.Count, "M").End(xlUp).Row
        ws2.Range("M2", "N" & rowCount + 1).ClearContents
        For Each TrackNo In rngInput
            Set TrackingFound = rngTrackingList.Find(TrackNo.Value2)
            If TrackingFound Is Nothing Then
                ws2.Range("K" & ws2.Cells(ws2.Rows.Count, "K").End(xlUp).Row + 1) = TrackNo.Value2
                Set rngTrackingList = ws2.Range("K2", "K" & ws2.Cells(ws2.Rows.Count, "K").End(xlUp).Row + 1)
            End If
        Next
        Set rngTrackingList = ws2.Range("K2", "K" & ws2.Cells(ws2.Rows.Count, "K").End(xlUp).Row)
        For Each TrackNo In rngInput
            Set TrackingFound = rngTrackingList.Find(TrackNo.Value2)
            For Each cellTrack In rngTrackingList
                For Each cellNumber In rngNumber
                    If cellNumber = TrackNo.Offset(0, 1) Then
                        cellNumber.Interior.Color = TrackingFound.Interior.Color
                    End If
                Next
            Next
        Next
    End If
    Set rngNumber = ws1.Range("B2", ws1.Cells(ws1.Rows.Count, "B").End(xlUp))
    For Each cellNumber In rngNumber
        Set rngHeader = ws2.Range("M2", "M" & ws2.Cells(ws2.Rows.Count, "M").End(xlUp).Row + 1)
        Set NumberFound = rngHeader.Find(cellNumber.Value2)
        If NumberFound Is Nothing Then
            nCount = Application.WorksheetFunction.CountIf(rngNumber, CStr(cellNumber))
            If nCount > 1 Then
                rowCount = ws2.Cells(ws2.Rows.Count, "M").End(xlUp).Row + 1
                ws2.Range("M" & rowCount) = cellNumber.Value2
                ws2.Range("N" & rowCount) = nCount
            End If
        End If
    Next
End If

End Sub