Forum Discussion
Need macro excel to show data on change of heading
Hi Experts, I am looking for vba script wherein if i change the heading in sheet 2 as "Table 1" or Table 2" it should automatically show me data in result table from sheet 1 matching the crietera...
Deleted
Here is the workbook with the updated code.
Deleted
Your sample output isn't correct - it doesn't match Table 1 and Table 2, and the dates in B30:C30 are in July instead of in August.
But this should do what you want:
- Right-click the sheet tab of Sheet1.
- Select 'View code' from the context menu.
- Copy the code listed below into the worksheet module:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long
Dim c As Long
Dim v As String
Dim d As Date
Dim s As String
Dim i As Long
Dim r0 As Long
Dim c0 As Long
If Not Intersect(Range("A26"), Target) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Range("B28:D29").ClearContents
Select Case Range("A26").Value
Case "Table 1"
c0 = 1
Case "Table 2"
c0 = 8
End Select
For r = 28 To 29
For c = 2 To 4
v = Cells(r, 1).Value
d = Cells(30, c).Value
s = ""
i = 0
For r0 = 3 To 7
If Cells(r0, c0 + 4).Value = v And Cells(r0, c0 + 5).Value = d Then
i = i + 1
s = s & vbLf & i & ". " & Cells(r0, c0 + 2).Value
End If
Next r0
If s <> "" Then
Cells(r, c).Value = Mid(s, 2)
End If
Next c
Next r
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End SubHansVogelaar Thank u. this works... though i forgot to mention that my data "Table 1" and "Table 2" keeps on increasing with new columns, new entries and increase dates so i need to accommodate all the data and show in the result table as and when the data gets increased.
Can you pls modify the code and re-send me which works dynamically depending upon the column and rows increased in data table.
Deleted
Will Table 1 and Table 2 always be the same size?
HansVogelaar Yes same size
Deleted
Here is a more dynamic version.
Private Sub Worksheet_Change(ByVal Target As Range) ' Change if you move the cell where you enter Table 1 or Table 2 Const OutputRow = 26 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 users As New Collection Dim dates As New Collection If Not Intersect(Range("A" & OutputRow), Target) Is Nothing Then Application.ScreenUpdating = False Application.EnableEvents = False Range("A" & OutputRow).CurrentRegion.Offset(1).Clear Select Case Range("A" & OutputRow).Value Case "Table 1" c0 = 1 Case "Table 2" c0 = 8 End Select m0 = Cells(2, c0).End(xlDown).Row On Error Resume Next For r0 = 3 To m0 users.Add Item:=Cells(r0, c0 + 4).Value, Key:=Cells(r0, c0 + 4).Value dates.Add Item:=Cells(r0, c0 + 5).Value, Key:=CStr(Cells(r0, c0 + 4).Value) Next r0 On Error GoTo 0 For r = 1 To users.Count Cells(OutputRow + r + 1, 1).Value = users(r) Next r For c = 1 To dates.Count Cells(OutputRow + 1, c + 1).Value = "Items" Cells(OutputRow + users.Count + 2, c + 1).Value = dates(c) Next c For r = 1 To users.Count For c = 1 To dates.Count s = "" i = 0 For r0 = 3 To m0 If Cells(r0, c0 + 4).Value = users(r) And Cells(r0, c0 + 5).Value = dates(c) Then i = i + 1 s = s & vbLf & i & ". " & Cells(r0, c0 + 2).Value End If Next r0 If s <> "" Then Cells(r + OutputRow + 1, c + 1).Value = Mid(s, 2) End If Next c Next r Range("A" & OutputRow + 1).Resize(users.Count + 2, dates.Count + 1).Borders.LineStyle = xlContinuous Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub