Need macro excel to show data on change of heading

HansVogelaar it's ok.. not to be sorry... u helped me to the fullest.

Thanks for your all your efforts, and your time. Your are wonderful and have good hands in programming

All the best !

Deleted 

I'm afraid this is beyond the scope of the help that I can offer you, sorry.

HansVogelaar Pls check attachment.

I have included a sample graph. i want to link the data shown in sample graph with sheet 4 with the latest sales record data (Example from row no 31).

the graph should change dynamically as and when the data of sheet 4 gets refresh with new latest data at the bottom.

Deleted 

Can you provide an example of what the chart should look like? Thanks in advance.

HansVogelaar - Hi, will it be possible to create bar graph using sheet 4 data.

HansVogelaar Thank u.. for sheet 4

Deleted 

As for Sheet2: I already mentioned that you should leave at least one empty row and column around the summary table, and that it is dangerous to place information to the right and below it. If you want to 'decorate' Sheet 2, place all the extra information at the top, and the summary table below it.

So in its current state, it won't work.

In the attached version, I have updated the code behind Sheet4. It should now handle inserting new rows and columns.

HansVogelaar i m not making complicated. I downloade this sheet from a tool which exports data dynamically in sheet 1.

The format in sheet 1 is not constant it dynamically changes with data every 2 mins. Sometimes the tool adds new columns in the sheet or sometimes not dynamically. Position  of columns are not fixed and defined in sheet 1.

Actually i want that code should read Sheet 1 Data and can run the functionality of Sheet 2, Sheet 3 and Sheet 4 no matter how many columns and rows are added in Sheet 1.

Only constant part in sheet one is headings. Even row no 1 "Table" is also not required in sheet 1. 

Deleted 

You're making it really complicated!

HansVogelaar yes i want i should be able to add column in sheet 1 (in middle or even in last)

Deleted 

Is it possible that you will add columns to the right of the Date column on Sheet1 in the future?

HansVogelaar -

Hey.. sheet 4 gives me an error if i add an extra column in sheet 1.

Also in Sheet 2 the functionality is not working if i shift the table in "D14" and decorate with the sheet with some info.

Demo Sheet attached.

HansVogelaar bRAVO.. aPPLUASE... MASTER you are.. CHEERS DUDE !

Thanks for every help. 

Deleted 

In the worksheet module of Sheet4:

Private Sub Worksheet_Activate()
    Dim m As Long
    Dim r As Long
    Dim r0 As Long
    Dim d As Date
    Dim n As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Range("C4:J" & Rows.Count).Clear
    With Worksheets("Sheet1")
        m = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("A3:F" & m).Copy Destination:=Range("C4")
    End With
    For r = 4 To m + 1
        With Range("H" & r)
            .Value = Int(.Value)
        End With
    Next r
    With Range("I4:I" & m + 1)
        .Formula = "=H4+1"
        .Value = .Value
    End With
    Range("H4:I" & m + 1).NumberFormat = "dddd, mmmm dd, yyyy"
    With Range("J4:J" & m + 1)
        .Formula = "=I4-H4"
        .Value = .Value
    End With
    Range("C4:J" & m + 1).HorizontalAlignment = xlHAlignCenter
    Range("H4:J" & m + 1).Borders.LineStyle = xlContinuous
    r = 4
    Do
        If Range("H" & r).Value > d + 6 Then
            d = Range("H" & r).Value
            d = d + 1 - Weekday(d, vbMonday)
            Range("C" & r).Resize(1, 8).Insert Shift:=xlShiftDown
            With Range("C" & r).Resize(1, 8)
                .Interior.Color = vbYellow
                .Font.Bold = True
            End With
            If r0 > 0 Then
                Range("J" & r0).Value = n
            Else
                Range("H" & r).Resize(1, 2).NumberFormat = "dddd, mmmm dd, yyyy"
            End If
            Range("C" & r).Value = "Code"
            Range("H" & r).Value = d
            Range("I" & r).Value = d + 4
            r0 = r
            n = 0
            r = r + 1
        End If
        n = n + Range("J" & r).Value
        r = r + 1
    Loop Until Range("C" & r).Value = ""
    If r0 > 0 Then
        Range("J" & r0).Value = n
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

HansVogelaar yes it will be From Date - To Date = 1

Deleted 

So 'No of Days' will always be 1?

HansVogelaar "To Date" = From Date + 1

Deleted 

Where does the "To Date" on Sheet4 come from?

Deleted 

Once again, a big request. I won't have a solution instantly.

Deleted 

If you want to add extra information on Sheet2, keep at least one empty row above the summary range, and one empty column to the left. Otherwise it becomes too difficult to keep track of which range the code should clear. It's dangerous to place data to the right or below the summary range: it might be overwritten when the summary range expands.

HansVogelaar - Hi, a small request can you pls change the design of sheet 3 like sheet 4 and show data week wise.

In Sheet 3 when data increases it difficult to view. functionality of sheet 3 will remain the same just change the design as per sheet 4.

demo excel attached

HansVogelaar i totally appreciate your efforts and time you are putting for this and thanks for providing me this sheet. you are awesome. u hv deep knowldge n hand on in excel programming. kudos to u.. n keep it up.

i hve one question. In sheet 2 result tab since i hv placed the table in "D14" i tried to add heading and some more content as information in that sheet and decorate the sheet beside this result table then it is giving me some offset error. i am not able to add any content above D14 or below and beside the table.

Deleted 

Please keep in mind that I am doing this entirely in my free time.

Here is a new version. Sheet3 is updated automatically when you switch to it from another sheet.

HansVogelaar i hope u r working on tall order.

Deleted 

This version lets you specify the top left cell.

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Change if you move the cell where you enter the code
    Const TopLeft = "D14"
    Dim wsh As Worksheet
    Dim cel As Range
    Dim tbl As Range
    Dim r As Long
    Dim c As Long
    Dim s As String
    Dim i As Long
    Dim r0 As Long
    Dim c0 As Long
    Dim m0 As Long
    Dim u As Long
    Dim d As Long
    Dim t As Long
    Dim users As New Collection
    Dim dates As New Collection
    
    Set cel = Range(TopLeft) 'Result
    If Not Intersect(cel, Target) Is Nothing Then
        ' Change name of worksheet with the data if needed
        Set wsh = Worksheets("Sheet1")
        c0 = 1
        Set tbl = wsh.Rows(2).Find(What:="User", LookAt:=xlWhole, MatchCase:=False)
        If tbl Is Nothing Then
            MsgBox "User column not found!", vbExclamation
            Exit Sub
        End If
        u = tbl.Column
        Set tbl = wsh.Rows(2).Find(What:="Date", LookAt:=xlWhole, MatchCase:=False)
        If tbl Is Nothing Then
            MsgBox "Date column not found!", vbExclamation
            Exit Sub
        End If
        d = tbl.Column
        Set tbl = wsh.Rows(2).Find(What:="Type", LookAt:=xlWhole, MatchCase:=False)
        If tbl Is Nothing Then
            MsgBox "Type column not found!", vbExclamation
            Exit Sub
        End If
        t = tbl.Column
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        With Intersect(cel.EntireRow, cel.CurrentRegion)
            .Interior.ColorIndex = xlColorIndexNone
            .Borders.LineStyle = xlLineStyleNone
        End With
        cel.CurrentRegion.Offset(1).Clear
        m0 = wsh.Cells(2, c0).End(xlDown).Row
        On Error Resume Next
        For r0 = 3 To m0
            If wsh.Cells(r0, c0).Value = cel.Value Then
                users.Add Item:=wsh.Cells(r0, u).Value, Key:=wsh.Cells(r0, u).Value
                dates.Add Item:=Int(wsh.Cells(r0, d).Value), Key:=CStr(Int(wsh.Cells(r0, d).Value))
            End If
        Next r0
        On Error GoTo 0
        SortCollection users
        For r = 1 To users.Count
            cel.Offset(r + 1, 0).Value = users(r)
        Next r
        SortCollection dates
        With cel.Resize(1, dates.Count + 1)
            .Interior.Color = RGB(0, 176, 80)
            .BorderAround LineStyle:=xlContinuous
        End With
        For c = 1 To dates.Count
            cel.Offset(1, c).Value = "Items"
            cel.Offset(users.Count + 2, c).Value = dates(c)
            If c Mod 2 Then
                cel.Offset(users.Count + 2, c).Interior.Color = RGB(197, 90, 17)
            Else
                cel.Offset(users.Count + 2, c).Interior.Color = RGB(61, 195, 176)
            End If
        Next c
        cel.Offset(2, 1).Resize(users.Count, dates.Count).Interior.Color = RGB(242, 242, 242)
        With cel.Offset(users.Count + 2).Resize(1, dates.Count + 1)
            .Font.Color = vbWhite
            .HorizontalAlignment = xlHAlignCenter
        End With
        For r = 1 To users.Count
            For c = 1 To dates.Count
                s = ""
                i = 0
                For r0 = 3 To m0
                    If wsh.Cells(r0, c0).Value = cel.Value And wsh.Cells(r0, u).Value = users(r) _
                            And Int(wsh.Cells(r0, d).Value) = dates(c) Then
                        i = i + 1
                        s = s & vbLf & i & ". " & wsh.Cells(r0, t).Value
                    End If
                Next r0
                If s <> "" Then
                    cel.Offset(r + 1, c).Value = Mid(s, 2)
                End If
            Next c
        Next r
        With cel.Offset(1).Resize(users.Count + 1, dates.Count + 1)
            .Borders.LineStyle = xlContinuous
            .VerticalAlignment = xlVAlignTop
        End With
        cel.Offset(1).Resize(1, dates.Count + 1).Interior.Color = RGB(255, 192, 0)
        With cel.Offset(users.Count + 2)
            .Value = "Date"
            .Interior.Color = RGB(0, 32, 96)
        End With
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub