SOLVED

Need macro excel to show data on change of heading

%3CLINGO-SUB%20id%3D%22lingo-sub-1572365%22%20slang%3D%22en-US%22%3ENeed%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1572365%22%20slang%3D%22en-US%22%3E%3CP%3EHi%20Experts%2C%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20am%20looking%20for%20vba%20script%20wherein%20if%20i%20change%20the%20heading%20in%20sheet%202%20as%20%22Table%201%22%20or%20Table%202%22%20it%20should%20automatically%20show%20me%20data%20in%20result%20table%20from%20sheet%201%20matching%20the%20crietera%20of%20%22%20Table%201%22%20or%20%22Table%202%22%20aligning%20with%20dates.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ECan%20you%20pls%20help%20me%20to%20provide%20maco%20vba%20script%20excel%20file.%20I%20am%20attaching%20sample%20file.%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-1572365%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EBI%20%26amp%3B%20Data%20Analysis%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3ECharting%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EExcel%20for%20web%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EExcel%20on%20mobile%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EFormulas%20and%20Functions%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EMacros%20and%20VBA%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EOffice%20365%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EUser%20Adoption%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1573182%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1573182%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F744293%22%20target%3D%22_blank%22%3E%40nkd8477%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3EYour%20sample%20output%20isn't%20correct%20-%20it%20doesn't%20match%20Table%201%20and%20Table%202%2C%20and%20the%20dates%20in%20B30%3AC30%20are%20in%20July%20instead%20of%20in%20August.%3C%2FP%3E%0A%3CP%3EBut%20this%20should%20do%20what%20you%20want%3A%3C%2FP%3E%0A%3CUL%3E%0A%3CLI%3ERight-click%20the%20sheet%20tab%20of%20Sheet1.%3C%2FLI%3E%0A%3CLI%3ESelect%20'View%20code'%20from%20the%20context%20menu.%3C%2FLI%3E%0A%3CLI%3ECopy%20the%20code%20listed%20below%20into%20the%20worksheet%20module%3A%3C%2FLI%3E%0A%3C%2FUL%3E%0A%3CPRE%20class%3D%22lia-code-sample%20language-visual%22%3E%3CCODE%3EPrivate%20Sub%20Worksheet_Change(ByVal%20Target%20As%20Range)%0A%20%20%20%20Dim%20r%20As%20Long%0A%20%20%20%20Dim%20c%20As%20Long%0A%20%20%20%20Dim%20v%20As%20String%0A%20%20%20%20Dim%20d%20As%20Date%0A%20%20%20%20Dim%20s%20As%20String%0A%20%20%20%20Dim%20i%20As%20Long%0A%20%20%20%20Dim%20r0%20As%20Long%0A%20%20%20%20Dim%20c0%20As%20Long%0A%20%20%20%20If%20Not%20Intersect(Range(%22A26%22)%2C%20Target)%20Is%20Nothing%20Then%0A%20%20%20%20%20%20%20%20Application.ScreenUpdating%20%3D%20False%0A%20%20%20%20%20%20%20%20Application.EnableEvents%20%3D%20False%0A%20%20%20%20%20%20%20%20Range(%22B28%3AD29%22).ClearContents%0A%20%20%20%20%20%20%20%20Select%20Case%20Range(%22A26%22).Value%0A%20%20%20%20%20%20%20%20%20%20%20%20Case%20%22Table%201%22%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20c0%20%3D%201%0A%20%20%20%20%20%20%20%20%20%20%20%20Case%20%22Table%202%22%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20c0%20%3D%208%0A%20%20%20%20%20%20%20%20End%20Select%0A%20%20%20%20%20%20%20%20For%20r%20%3D%2028%20To%2029%0A%20%20%20%20%20%20%20%20%20%20%20%20For%20c%20%3D%202%20To%204%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20v%20%3D%20Cells(r%2C%201).Value%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20d%20%3D%20Cells(30%2C%20c).Value%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20s%20%3D%20%22%22%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20i%20%3D%200%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20For%20r0%20%3D%203%20To%207%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20If%20Cells(r0%2C%20c0%20%2B%204).Value%20%3D%20v%20And%20Cells(r0%2C%20c0%20%2B%205).Value%20%3D%20d%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20i%20%3D%20i%20%2B%201%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20s%20%3D%20s%20%26amp%3B%20vbLf%20%26amp%3B%20i%20%26amp%3B%20%22.%20%22%20%26amp%3B%20Cells(r0%2C%20c0%20%2B%202).Value%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Next%20r0%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20If%20s%20%26lt%3B%26gt%3B%20%22%22%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Cells(r%2C%20c).Value%20%3D%20Mid(s%2C%202)%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%20%20%20%20%20%20Next%20c%0A%20%20%20%20%20%20%20%20Next%20r%0A%20%20%20%20%20%20%20%20Application.EnableEvents%20%3D%20True%0A%20%20%20%20%20%20%20%20Application.ScreenUpdating%20%3D%20True%0A%20%20%20%20End%20If%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1574207%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1574207%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F127945%22%20target%3D%22_blank%22%3E%40Hans%20Vogelaar%3C%2FA%3E%26nbsp%3BThank%20u.%20this%20works...%20though%20i%20forgot%20to%20mention%20that%20my%20data%20%22Table%201%22%20and%20%22Table%202%22%20keeps%20on%20increasing%20with%20new%20columns%2C%20new%20entries%20and%20increase%20dates%20so%20i%20need%20to%20accommodate%20all%20the%20data%20and%20show%20in%20the%20result%20table%20as%20and%20when%20the%20data%20gets%20increased.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ECan%20you%20pls%20modify%20the%20code%20and%20re-send%20me%20which%20works%20dynamically%20depending%20upon%20the%20column%20and%20rows%20increased%20in%20data%20table.%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1574410%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1574410%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F744293%22%20target%3D%22_blank%22%3E%40nkd8477%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3EWill%20Table%201%20and%20Table%202%20always%20be%20the%20same%20size%3F%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1574423%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1574423%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F127945%22%20target%3D%22_blank%22%3E%40Hans%20Vogelaar%3C%2FA%3E%26nbsp%3BYes%20same%20size%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1574530%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1574530%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F744293%22%20target%3D%22_blank%22%3E%40nkd8477%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3EHere%20is%20a%20more%20dynamic%20version.%3C%2FP%3E%0A%3CPRE%20class%3D%22lia-code-sample%20language-visual%22%3E%3CCODE%3EPrivate%20Sub%20Worksheet_Change(ByVal%20Target%20As%20Range)%0A%20%20%20%20'%20Change%20if%20you%20move%20the%20cell%20where%20you%20enter%20Table%201%20or%20Table%202%0A%20%20%20%20Const%20OutputRow%20%3D%2026%0A%20%20%20%20Dim%20r%20As%20Long%0A%20%20%20%20Dim%20c%20As%20Long%0A%20%20%20%20Dim%20s%20As%20String%0A%20%20%20%20Dim%20i%20As%20Long%0A%20%20%20%20Dim%20r0%20As%20Long%0A%20%20%20%20Dim%20c0%20As%20Long%0A%20%20%20%20Dim%20m0%20As%20Long%0A%20%20%20%20Dim%20users%20As%20New%20Collection%0A%20%20%20%20Dim%20dates%20As%20New%20Collection%0A%20%20%20%20If%20Not%20Intersect(Range(%22A%22%20%26amp%3B%20OutputRow)%2C%20Target)%20Is%20Nothing%20Then%0A%20%20%20%20%20%20%20%20Application.ScreenUpdating%20%3D%20False%0A%20%20%20%20%20%20%20%20Application.EnableEvents%20%3D%20False%0A%20%20%20%20%20%20%20%20Range(%22A%22%20%26amp%3B%20OutputRow).CurrentRegion.Offset(1).Clear%0A%20%20%20%20%20%20%20%20Select%20Case%20Range(%22A%22%20%26amp%3B%20OutputRow).Value%0A%20%20%20%20%20%20%20%20%20%20%20%20Case%20%22Table%201%22%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20c0%20%3D%201%0A%20%20%20%20%20%20%20%20%20%20%20%20Case%20%22Table%202%22%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20c0%20%3D%208%0A%20%20%20%20%20%20%20%20End%20Select%0A%20%20%20%20%20%20%20%20m0%20%3D%20Cells(2%2C%20c0).End(xlDown).Row%0A%20%20%20%20%20%20%20%20On%20Error%20Resume%20Next%0A%20%20%20%20%20%20%20%20For%20r0%20%3D%203%20To%20m0%0A%20%20%20%20%20%20%20%20%20%20%20%20users.Add%20Item%3A%3DCells(r0%2C%20c0%20%2B%204).Value%2C%20Key%3A%3DCells(r0%2C%20c0%20%2B%204).Value%0A%20%20%20%20%20%20%20%20%20%20%20%20dates.Add%20Item%3A%3DCells(r0%2C%20c0%20%2B%205).Value%2C%20Key%3A%3DCStr(Cells(r0%2C%20c0%20%2B%204).Value)%0A%20%20%20%20%20%20%20%20Next%20r0%0A%20%20%20%20%20%20%20%20On%20Error%20GoTo%200%0A%20%20%20%20%20%20%20%20For%20r%20%3D%201%20To%20users.Count%0A%20%20%20%20%20%20%20%20%20%20%20%20Cells(OutputRow%20%2B%20r%20%2B%201%2C%201).Value%20%3D%20users(r)%0A%20%20%20%20%20%20%20%20Next%20r%0A%20%20%20%20%20%20%20%20For%20c%20%3D%201%20To%20dates.Count%0A%20%20%20%20%20%20%20%20%20%20%20%20Cells(OutputRow%20%2B%201%2C%20c%20%2B%201).Value%20%3D%20%22Items%22%0A%20%20%20%20%20%20%20%20%20%20%20%20Cells(OutputRow%20%2B%20users.Count%20%2B%202%2C%20c%20%2B%201).Value%20%3D%20dates(c)%0A%20%20%20%20%20%20%20%20Next%20c%0A%20%20%20%20%20%20%20%20For%20r%20%3D%201%20To%20users.Count%0A%20%20%20%20%20%20%20%20%20%20%20%20For%20c%20%3D%201%20To%20dates.Count%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20s%20%3D%20%22%22%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20i%20%3D%200%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20For%20r0%20%3D%203%20To%20m0%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20If%20Cells(r0%2C%20c0%20%2B%204).Value%20%3D%20users(r)%20And%20Cells(r0%2C%20c0%20%2B%205).Value%20%3D%20dates(c)%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20i%20%3D%20i%20%2B%201%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20s%20%3D%20s%20%26amp%3B%20vbLf%20%26amp%3B%20i%20%26amp%3B%20%22.%20%22%20%26amp%3B%20Cells(r0%2C%20c0%20%2B%202).Value%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Next%20r0%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20If%20s%20%26lt%3B%26gt%3B%20%22%22%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Cells(r%20%2B%20OutputRow%20%2B%201%2C%20c%20%2B%201).Value%20%3D%20Mid(s%2C%202)%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%20%20%20%20%20%20Next%20c%0A%20%20%20%20%20%20%20%20Next%20r%0A%20%20%20%20%20%20%20%20Range(%22A%22%20%26amp%3B%20OutputRow%20%2B%201).Resize(users.Count%20%2B%202%2C%20dates.Count%20%2B%201).Borders.LineStyle%20%3D%20xlContinuous%0A%20%20%20%20%20%20%20%20Application.EnableEvents%20%3D%20True%0A%20%20%20%20%20%20%20%20Application.ScreenUpdating%20%3D%20True%0A%20%20%20%20End%20If%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1574658%22%20slang%3D%22en-US%22%3ERE%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1574658%22%20slang%3D%22en-US%22%3Ebetter%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1574717%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1574717%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F127945%22%20target%3D%22_blank%22%3E%40Hans%20Vogelaar%3C%2FA%3E%26nbsp%3BHi%2C%20thanks%20i%20pasted%20the%20code%20in%20my%20sheet%20but%20it%20is%20not%20working..%20sheet%20attched%20with%20your%20code.%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1574747%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1574747%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F744293%22%20target%3D%22_blank%22%3E%40nkd8477%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3EWhat%20exactly%20is%20the%20problem%3F%20I%20downloaded%20your%20workbook%20and%20entered%20Table%201%20and%20Table%202%20in%20A26.%20This%20was%20the%20result%3A%3C%2FP%3E%0A%3CP%3E%3CSPAN%20class%3D%22lia-inline-image-display-wrapper%20lia-image-align-inline%22%20image-alt%3D%22S3451.png%22%20style%3D%22width%3A%20383px%3B%22%3E%3CIMG%20src%3D%22https%3A%2F%2Fgxcuf89792.i.lithium.com%2Ft5%2Fimage%2Fserverpage%2Fimage-id%2F211097i93A0B13E8BA336C9%2Fimage-size%2Flarge%3Fv%3D1.0%26amp%3Bpx%3D999%22%20title%3D%22S3451.png%22%20alt%3D%22S3451.png%22%20%2F%3E%3C%2FSPAN%3E%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1574823%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1574823%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F744293%22%20target%3D%22_blank%22%3E%40nkd8477%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3EYou%20had%20mentioned%20that%20you%20would%20add%20rows%2C%20but%20not%20that%20you%20would%20add%20columns.%3C%2FP%3E%0A%3CP%3ECurrently%20the%20code%20assumes%20that%20the%20tables%20start%20in%20columns%20A%20and%20H.%20To%20make%20that%20dynamic%20will%20take%20more%20work%2C%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1574777%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1574777%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F127945%22%20target%3D%22_blank%22%3E%40Hans%20Vogelaar%3C%2FA%3E%26nbsp%3BHi%2C%20my%20requirement%20is%20little%20changed%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EInstead%20of%20typing%20Table%201%20or%20Table%202%20in%20A26%20Result%20column%20can%20i%20type%20code%20FR%20and%20VG%20code%20in%20A26%20and%20show%20all%20data%20of%20of%20respective%20FR%20or%20VG%20in%20result%20table%20considering%20irrespective%20if%20i%20add%20new%20columns%20in%20middle%20of%20data%20table%201%20or%20table%202%20or%20increase%20rows%20with%20more%20data%20and%20keeping%20intact%20the%20original%20design%20color%20of%20result%20table%20as%20it%20is.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ECan%20u%20pls%20send%20updated%20sheet%20with%20your%20updated%20dynamic%20code.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1575124%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1575124%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F744293%22%20target%3D%22_blank%22%3E%40nkd8477%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3EHere%20is%20the%20workbook%20with%20the%20updated%20code.%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1575591%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1575591%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F127945%22%20target%3D%22_blank%22%3E%40Hans%20Vogelaar%3C%2FA%3E%26nbsp%3BAwesome.%20Thank%20u%20kuddos%20to%20u..%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1575611%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1575611%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F127945%22%20target%3D%22_blank%22%3E%40Hans%20Vogelaar%3C%2FA%3E%26nbsp%3BHi%2C%20one%20last%20question%20if%20i%20want%20to%20shift%20Result%20table%20in%20sheet%202%20then%20in%20code%20where%20i%20need%20to%20make%20changes.%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1575814%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1575814%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F744293%22%20target%3D%22_blank%22%3E%40nkd8477%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3ESee%20the%20attached%20version.%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1576224%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1576224%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F127945%22%20target%3D%22_blank%22%3E%40Hans%20Vogelaar%3C%2FA%3E%26nbsp%3BThanks..%20Cheers..%20Dude%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1576248%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1576248%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F127945%22%20target%3D%22_blank%22%3E%40Hans%20Vogelaar%3C%2FA%3E%26nbsp%3BSuppose%20if%20i%20want%20merge%20table%202%20with%20table%201%20in%20data%20and%20want%20to%20FR%2C%20VG%20in%20Result%20then%20which%20line%20i%20should%20change%20the%20code%20also%20in%20Date%20column%20in%20some%20rows%20in%20data%20i%20have%20date%20%2B%20time%2015-11-2019%2007%3A44%3A27%20how%20can%20i%20split%20this%20and%20show%20only%20date.%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1576258%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1576258%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F744293%22%20target%3D%22_blank%22%3E%40nkd8477%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3ECould%20you%20attach%20a%20new%20sample%20workbook%3F%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1576331%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1576331%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F127945%22%20target%3D%22_blank%22%3E%40Hans%20Vogelaar%3C%2FA%3E%26nbsp%3BCheck%20workbook%20in%20attachment.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20just%20have%20now%20table%201.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3Ei%20want%20to%20show%20data%20in%20sheet%202%20in%20result%20depending%20upon%20the%20code%20i%20select%20%22FR%22%20or%20%22VG%22%20or%20%22DR%22%20no%20matter%20how%20much%20column%20and%20rows%20i%20insert%20or%20delete%20in%20sheet%201%20in%20data%20table%201.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EAlso%20i%20want%20to%20show%20date%20in%20result%20in%20sheet%202%20and%20and%20not%20date%20time%2206-11-2019%2009%3A50%3A00%22.%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1576340%22%20slang%3D%22en-US%22%3ERe%3A%20Need%20macro%20excel%20to%20show%20data%20on%20change%20of%20heading%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1576340%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F744293%22%20target%3D%22_blank%22%3E%40nkd8477%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3EHere%20you%20go.%20I%20assumed%20that%20Code%20will%20remain%20column%20A%20on%20Sheet1.%3C%2FP%3E%0A%3CPRE%20class%3D%22lia-code-sample%20language-visual%22%3E%3CCODE%3EPrivate%20Sub%20Worksheet_Change(ByVal%20Target%20As%20Range)%0A%20%20%20%20'%20Change%20if%20you%20move%20the%20cell%20where%20you%20enter%20the%20code%0A%20%20%20%20Const%20OutputRow%20%3D%202%0A%20%20%20%20Dim%20wsh%20As%20Worksheet%0A%20%20%20%20Dim%20cel%20As%20Range%0A%20%20%20%20Dim%20tbl%20As%20Range%0A%20%20%20%20Dim%20r%20As%20Long%0A%20%20%20%20Dim%20c%20As%20Long%0A%20%20%20%20Dim%20s%20As%20String%0A%20%20%20%20Dim%20i%20As%20Long%0A%20%20%20%20Dim%20r0%20As%20Long%0A%20%20%20%20Dim%20c0%20As%20Long%0A%20%20%20%20Dim%20m0%20As%20Long%0A%20%20%20%20Dim%20u%20As%20Long%0A%20%20%20%20Dim%20d%20As%20Long%0A%20%20%20%20Dim%20t%20As%20Long%0A%20%20%20%20Dim%20users%20As%20New%20Collection%0A%20%20%20%20Dim%20dates%20As%20New%20Collection%0A%20%20%20%20%0A%20%20%20%20Set%20cel%20%3D%20Cells(OutputRow%2C%201)%20'Result%0A%20%20%20%20If%20Not%20Intersect(cel%2C%20Target)%20Is%20Nothing%20Then%0A%20%20%20%20%20%20%20%20'%20Change%20name%20of%20worksheet%20with%20the%20data%20if%20needed%0A%20%20%20%20%20%20%20%20Set%20wsh%20%3D%20Worksheets(%22Sheet1%22)%0A%20%20%20%20%20%20%20%20c0%20%3D%201%0A%20%20%20%20%20%20%20%20Set%20tbl%20%3D%20wsh.Rows(2).Find(What%3A%3D%22User%22%2C%20LookAt%3A%3DxlWhole%2C%20MatchCase%3A%3DFalse)%0A%20%20%20%20%20%20%20%20If%20tbl%20Is%20Nothing%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20MsgBox%20%22User%20column%20not%20found!%22%2C%20vbExclamation%0A%20%20%20%20%20%20%20%20%20%20%20%20Exit%20Sub%0A%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%20%20u%20%3D%20tbl.Column%0A%20%20%20%20%20%20%20%20Set%20tbl%20%3D%20wsh.Rows(2).Find(What%3A%3D%22Date%22%2C%20LookAt%3A%3DxlWhole%2C%20MatchCase%3A%3DFalse)%0A%20%20%20%20%20%20%20%20If%20tbl%20Is%20Nothing%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20MsgBox%20%22Date%20column%20not%20found!%22%2C%20vbExclamation%0A%20%20%20%20%20%20%20%20%20%20%20%20Exit%20Sub%0A%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%20%20d%20%3D%20tbl.Column%0A%20%20%20%20%20%20%20%20Set%20tbl%20%3D%20wsh.Rows(2).Find(What%3A%3D%22Type%22%2C%20LookAt%3A%3DxlWhole%2C%20MatchCase%3A%3DFalse)%0A%20%20%20%20%20%20%20%20If%20tbl%20Is%20Nothing%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20MsgBox%20%22Type%20column%20not%20found!%22%2C%20vbExclamation%0A%20%20%20%20%20%20%20%20%20%20%20%20Exit%20Sub%0A%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%20%20t%20%3D%20tbl.Column%0A%20%20%20%20%20%20%20%20Application.ScreenUpdating%20%3D%20False%0A%20%20%20%20%20%20%20%20Application.EnableEvents%20%3D%20False%0A%20%20%20%20%20%20%20%20With%20cel.EntireRow%0A%20%20%20%20%20%20%20%20%20%20%20%20.Interior.ColorIndex%20%3D%20xlColorIndexNone%0A%20%20%20%20%20%20%20%20%20%20%20%20.Borders.LineStyle%20%3D%20xlLineStyleNone%0A%20%20%20%20%20%20%20%20End%20With%0A%20%20%20%20%20%20%20%20cel.CurrentRegion.Offset(1).Clear%0A%20%20%20%20%20%20%20%20m0%20%3D%20wsh.Cells(2%2C%20c0).End(xlDown).Row%0A%20%20%20%20%20%20%20%20On%20Error%20Resume%20Next%0A%20%20%20%20%20%20%20%20For%20r0%20%3D%203%20To%20m0%0A%20%20%20%20%20%20%20%20%20%20%20%20users.Add%20Item%3A%3Dwsh.Cells(r0%2C%20u).Value%2C%20Key%3A%3Dwsh.Cells(r0%2C%20u).Value%0A%20%20%20%20%20%20%20%20%20%20%20%20dates.Add%20Item%3A%3Dwsh.Cells(r0%2C%20d).Value%2C%20Key%3A%3DCStr(wsh.Cells(r0%2C%20d).Value)%0A%20%20%20%20%20%20%20%20Next%20r0%0A%20%20%20%20%20%20%20%20On%20Error%20GoTo%200%0A%20%20%20%20%20%20%20%20SortCollection%20users%0A%20%20%20%20%20%20%20%20For%20r%20%3D%201%20To%20users.Count%0A%20%20%20%20%20%20%20%20%20%20%20%20Cells(OutputRow%20%2B%20r%20%2B%201%2C%201).Value%20%3D%20users(r)%0A%20%20%20%20%20%20%20%20Next%20r%0A%20%20%20%20%20%20%20%20SortCollection%20dates%0A%20%20%20%20%20%20%20%20With%20cel.Resize(1%2C%20dates.Count%20%2B%201)%0A%20%20%20%20%20%20%20%20%20%20%20%20.Interior.Color%20%3D%20RGB(0%2C%20176%2C%2080)%0A%20%20%20%20%20%20%20%20%20%20%20%20.BorderAround%20LineStyle%3A%3DxlContinuous%0A%20%20%20%20%20%20%20%20End%20With%0A%20%20%20%20%20%20%20%20For%20c%20%3D%201%20To%20dates.Count%0A%20%20%20%20%20%20%20%20%20%20%20%20cel.Offset(1%2C%20c).Value%20%3D%20%22Items%22%0A%20%20%20%20%20%20%20%20%20%20%20%20cel.Offset(users.Count%20%2B%202%2C%20c).Value%20%3D%20dates(c)%0A%20%20%20%20%20%20%20%20%20%20%20%20If%20c%20Mod%202%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20cel.Offset(users.Count%20%2B%202%2C%20c).Interior.Color%20%3D%20RGB(197%2C%2090%2C%2017)%0A%20%20%20%20%20%20%20%20%20%20%20%20Else%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20cel.Offset(users.Count%20%2B%202%2C%20c).Interior.Color%20%3D%20RGB(61%2C%20195%2C%20176)%0A%20%20%20%20%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%20%20Next%20c%0A%20%20%20%20%20%20%20%20cel.Offset(2%2C%201).Resize(users.Count%2C%20dates.Count).Interior.Color%20%3D%20RGB(242%2C%20242%2C%20242)%0A%20%20%20%20%20%20%20%20With%20cel.Offset(users.Count%20%2B%202).Resize(1%2C%20dates.Count%20%2B%201)%0A%20%20%20%20%20%20%20%20%20%20%20%20.Font.Color%20%3D%20vbWhite%0A%20%20%20%20%20%20%20%20%20%20%20%20.HorizontalAlignment%20%3D%20xlHAlignCenter%0A%20%20%20%20%20%20%20%20End%20With%0A%20%20%20%20%20%20%20%20For%20r%20%3D%201%20To%20users.Count%0A%20%20%20%20%20%20%20%20%20%20%20%20For%20c%20%3D%201%20To%20dates.Count%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20s%20%3D%20%22%22%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20i%20%3D%200%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20For%20r0%20%3D%203%20To%20m0%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20If%20wsh.Cells(r0%2C%20c0).Value%20%3D%20cel.Value%20And%20wsh.Cells(r0%2C%20u).Value%20%3D%20users(r)%20_%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20And%20wsh.Cells(r0%2C%20d).Value%20%3D%20dates(c)%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20i%20%3D%20i%20%2B%201%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20s%20%3D%20s%20%26amp%3B%20vbLf%20%26amp%3B%20i%20%26amp%3B%20%22.%20%22%20%26amp%3B%20wsh.Cells(r0%2C%20t).Value%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Next%20r0%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20If%20s%20%26lt%3B%26gt%3B%20%22%22%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Cells(r%20%2B%20OutputRow%20%2B%201%2C%20c%20%2B%201).Value%20%3D%20Mid(s%2C%202)%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%20%20%20%20%20%20Next%20c%0A%20%20%20%20%20%20%20%20Next%20r%0A%20%20%20%20%20%20%20%20With%20cel.Offset(1).Resize(users.Count%20%2B%201%2C%20dates.Count%20%2B%201)%0A%20%20%20%20%20%20%20%20%20%20%20%20.Borders.LineStyle%20%3D%20xlContinuous%0A%20%20%20%20%20%20%20%20%20%20%20%20.VerticalAlignment%20%3D%20xlVAlignTop%0A%20%20%20%20%20%20%20%20End%20With%0A%20%20%20%20%20%20%20%20cel.Offset(1).Resize(1%2C%20dates.Count%20%2B%201).Interior.Color%20%3D%20RGB(255%2C%20192%2C%200)%0A%20%20%20%20%20%20%20%20With%20cel.Offset(users.Count%20%2B%202)%0A%20%20%20%20%20%20%20%20%20%20%20%20.Value%20%3D%20%22Date%22%0A%20%20%20%20%20%20%20%20%20%20%20%20.Interior.Color%20%3D%20RGB(0%2C%2032%2C%2096)%0A%20%20%20%20%20%20%20%20End%20With%0A%20%20%20%20%20%20%20%20Application.EnableEvents%20%3D%20True%0A%20%20%20%20%20%20%20%20Application.ScreenUpdating%20%3D%20True%0A%20%20%20%20End%20If%0AEnd%20Sub%0A%0ASub%20SortCollection(col%20As%20Collection)%0A%20%20%20%20Dim%20i%20As%20Long%0A%20%20%20%20Dim%20j%20As%20Long%0A%20%20%20%20Dim%20vTemp%20As%20Variant%0A%20%20%20%20For%20i%20%3D%201%20To%20col.Count%20-%201%0A%20%20%20%20%20%20%20%20For%20j%20%3D%20i%20%2B%201%20To%20col.Count%0A%20%20%20%20%20%20%20%20%20%20%20%20If%20col(i)%20%26gt%3B%20col(j)%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20vTemp%20%3D%20col(j)%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20col.Remove%20j%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20col.Add%20Item%3A%3DvTemp%2C%20Key%3A%3DCStr(vTemp)%2C%20Before%3A%3Di%0A%20%20%20%20%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%20%20Next%20j%0A%20%20%20%20Next%20i%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3C%2FLINGO-BODY%3E
Highlighted
Deleted
Not applicable

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 of " Table 1" or "Table 2" aligning with dates.

 

Can you pls help me to provide maco vba script excel file. I am attaching sample file.

51 Replies
Highlighted

@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 Sub
Highlighted

@Hans Vogelaar 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.

Highlighted

@Deleted 

Will Table 1 and Table 2 always be the same size?

Highlighted
Highlighted

@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
Highlighted
Highlighted

@Hans Vogelaar Hi, thanks i pasted the code in my sheet but it is not working.. sheet attched with your code.

Highlighted

@Deleted 

What exactly is the problem? I downloaded your workbook and entered Table 1 and Table 2 in A26. This was the result:

S3451.png

Highlighted

@Hans Vogelaar Hi, my requirement is little changed

 

Instead of typing Table 1 or Table 2 in A26 Result column can i type code FR and VG code in A26 and show all data of of respective FR or VG in result table considering irrespective if i add new columns in middle of data table 1 or table 2 or increase rows with more data and keeping intact the original design color of result table as it is.

 

Can u pls send updated sheet with your updated dynamic code.

 

 

 

Highlighted

@Deleted 

You had mentioned that you would add rows, but not that you would add columns.

Currently the code assumes that the tables start in columns A and H. To make that dynamic will take more work,

Highlighted
Best Response
Solution

@Deleted 

 

Here is the workbook with the updated code.

Highlighted

@Hans Vogelaar Awesome. Thank u kuddos to u..

Highlighted

@Hans Vogelaar Hi, one last question if i want to shift Result table in sheet 2 then in code where i need to make changes.

Highlighted

@Deleted 

See the attached version.

Highlighted

@Hans Vogelaar Thanks.. Cheers.. Dude

Highlighted

@Hans Vogelaar Suppose if i want merge table 2 with table 1 in data and want to FR, VG in Result then which line i should change the code also in Date column in some rows in data i have date + time 15-11-2019 07:44:27 how can i split this and show only date.

Highlighted

@Deleted 

Could you attach a new sample workbook?

Highlighted

@Hans Vogelaar Check workbook in attachment.

 

I just have now table 1.

 

i want to show data in sheet 2 in result depending upon the code i select "FR" or "VG" or "DR" no matter how much column and rows i insert or delete in sheet 1 in data table 1.

 

Also i want to show date in result in sheet 2 and and not date time"06-11-2019 09:50:00".

Highlighted

@Deleted 

Here you go. I assumed that Code will remain column A on Sheet1.

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Change if you move the cell where you enter the code
    Const OutputRow = 2
    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 = Cells(OutputRow, 1) '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 cel.EntireRow
            .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
            users.Add Item:=wsh.Cells(r0, u).Value, Key:=wsh.Cells(r0, u).Value
            dates.Add Item:=wsh.Cells(r0, d).Value, Key:=CStr(wsh.Cells(r0, d).Value)
        Next r0
        On Error GoTo 0
        SortCollection users
        For r = 1 To users.Count
            Cells(OutputRow + r + 1, 1).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 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
                    Cells(r + OutputRow + 1, c + 1).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

Sub SortCollection(col As Collection)
    Dim i As Long
    Dim j As Long
    Dim vTemp As Variant
    For i = 1 To col.Count - 1
        For j = i + 1 To col.Count
            If col(i) > col(j) Then
                vTemp = col(j)
                col.Remove j
                col.Add Item:=vTemp, Key:=CStr(vTemp), Before:=i
            End If
        Next j
    Next i
End Sub