Press a cell and then create cells with specific formula

U

Unexpc

Active Member
Joined
Nov 12, 2020
Messages
496
Office Version
  1. 2019
Platform
  1. Windows
Hi guys
i have sheet that just list of customers, i insert costumers name in one column and other data i want to have in next columns
for name of customers of have this formula : =HYPERLINK("#'Sheet name'!A"&MATCH("Name of Customer",Sheet name!A:A,0),"Name of Customer")
sheet name that is sheet customer that belong data in it, for example for me Work for sheet name
another formula this is in next columns
=IFERROR(INDEX(Sheet name!B:B,MATCH($I4,Sheet name!A:A,0)-2,0),"")
=IFERROR(SUM(INDEX(Sheet name!D:D,MATCH($I3,Sheet name!A:A,0)+1,0):INDEX(Sheet name!E:E,MATCH($I4,Sheet name!A:A,0)-2,0)),"")
=IFERROR(SUM(INDEX(Sheet name!F:F,MATCH($I3,Sheet name!A:A,0)+1,0):INDEX(Sheet name!G:G,MATCH($I4,Sheet name!A:A,0)-2,0)),"")
this 3 formulas drag and fill in next rows
now
i want when select cell after last customer that may write NEW CUSTOMER, create a new first formula with the name that i write and then drag and fill this 3 formulas in that row and still stay this cell NEW CUSTOMER after that...
 

Attachments

  • Screenshot 2021-03-27 180521.png
    Screenshot 2021-03-27 180521.png
    7 KB · Views: 18
  • Screenshot 2021-03-27 180524.png
    Screenshot 2021-03-27 180524.png
    11.6 KB · Views: 17
Sort by date Sort by votes
maabadi said:
1. it doesn't make problem. when you input new customer name then formula copied above row and cells filled.
2. For this, you only need to add Customer Name. I add Hyperlink to Cells without formula & with VBA method then when you Press them you go to target Cell. No Problem
Click to expand...
1. please test it, when i test drag and fill is ok but because of a row between last customer and new customer after select new customer cell, last customer cell is empty
2. this need this formula, because that is linked to another sheet and find specific name on that sheet, without it there is no find and show error
First two photo about 1 and error photo about 2
 

Attachments

  • Screenshot 2021-04-03 154321.png
    Screenshot 2021-04-03 154321.png
    7.8 KB · Views: 4
  • Screenshot 2021-04-03 154328.png
    Screenshot 2021-04-03 154328.png
    8.9 KB · Views: 3
  • Screenshot 2021-04-03 154413.png
    Screenshot 2021-04-03 154413.png
    6.2 KB · Views: 4
Upvote 0

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
and when i select new customer again that first select, drag and fill does not correct (cells is empty) and last customer before i select new customer, change formula to wrong order of before that
 
Upvote 0
you cann't drag & fill first column of Data for each worksheet, because you enter the name of customer within your formula not your address (or Range).
you should insert customer names. or add worksheet change event for work & Paper sheet or ....
 
Upvote 0
Delete worksheet change & Selection Change event and Replace this:
when you press new customer for each sheet it automatically add new customer name based values at target sheet. don't need Drag & fill at all.
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Dim i As Long, j As Long, Lr1 As Long, Lr2 As Long, Cr1 As Long, Cr1R As String, Cr2 As Long, Cr2R As String
Dim Lr3 As Long, Lr4 As Long
 Lr1 = Range("I" & Rows.Count).End(xlUp).Row
 Lr2 = Range("N" & Rows.Count).End(xlUp).Row
 Lr3 = Sheets("Work").Range("A" & Rows.Count).End(xlUp).Row
 Lr4 = Sheets("Paper").Range("A" & Rows.Count).End(xlUp).Row
 'Lr5 = Sheets("Paper").Range("A" & Rows.Count).End(xlUp).Row
 On Error Resume Next
  
  If Not Intersect(Target, Range("I" & Lr1)) Is Nothing Then
   If Target.Count = 1 Then
    Application.EnableEvents = False
     Range("I" & Lr1 & ":M" & Lr1).Insert Shift:=xlDown
     Range("I" & Lr1).Value = Sheets("Work").Range("A" & (Lr1 - 3) * 6 + 1).Value
     Cr1 = Application.WorksheetFunction.Match(Range("I" & Lr1).Value, Sheets("Work").Range("A1:A" & Lr3), 0)
     Cr1R = Range("A" & Cr1).Address
     Range("J" & Lr1 - 1 & ":L" & Lr1 - 1).AutoFill Destination:=Range("J" & Lr1 - 1 & ":L" & Lr1)
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("I" & Lr1), Address:="", SubAddress:="'" & Sheets("Work").Name & "'!" & Cr1R, TextToDisplay:=Range("I" & Lr1).Value
    Application.EnableEvents = True
   End If
  End If
    If Not Intersect(Target, Range("N" & Lr2)) Is Nothing Then
   If Target.Count = 1 Then
    Application.EnableEvents = False
     Range("N" & Lr2 & ":Q" & Lr2).Insert Shift:=xlDown
     Range("N" & Lr2).Value = Sheets("Paper").Range("A" & (Lr2 - 3) * 6 + 1).Value
     Cr2 = Application.WorksheetFunction.Match(Range("N" & Lr2).Value, Sheets("Paper").Range("A1:A" & Lr4), 0)
     Cr2R = Range("A" & Cr2).Address
     Range("O" & Lr2 - 1 & ":Q" & Lr2 - 1).AutoFill Destination:=Range("O" & Lr2 - 1 & ":Q" & Lr2)
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("N" & Lr2), Address:="", SubAddress:="'" & Sheets("Paper").Name & "'!" & Cr2R, TextToDisplay:=Range("N" & Lr2).Value
    Application.EnableEvents = True
   End If
  End If
End Sub
 
Upvote 0
maabadi said:
Delete worksheet change & Selection Change event and Replace this:
when you press new customer for each sheet it automatically add new customer name based values at target sheet. don't need Drag & fill at all.
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long, j As Long, Lr1 As Long, Lr2 As Long, Cr1 As Long, Cr1R As String, Cr2 As Long, Cr2R As String
Dim Lr3 As Long, Lr4 As Long
Lr1 = Range("I" & Rows.Count).End(xlUp).Row
Lr2 = Range("N" & Rows.Count).End(xlUp).Row
Lr3 = Sheets("Work").Range("A" & Rows.Count).End(xlUp).Row
Lr4 = Sheets("Paper").Range("A" & Rows.Count).End(xlUp).Row
'Lr5 = Sheets("Paper").Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
 
  If Not Intersect(Target, Range("I" & Lr1)) Is Nothing Then
   If Target.Count = 1 Then
    Application.EnableEvents = False
     Range("I" & Lr1 & ":M" & Lr1).Insert Shift:=xlDown
     Range("I" & Lr1).Value = Sheets("Work").Range("A" & (Lr1 - 3) * 6 + 1).Value
     Cr1 = Application.WorksheetFunction.Match(Range("I" & Lr1).Value, Sheets("Work").Range("A1:A" & Lr3), 0)
     Cr1R = Range("A" & Cr1).Address
     Range("J" & Lr1 - 1 & ":L" & Lr1 - 1).AutoFill Destination:=Range("J" & Lr1 - 1 & ":L" & Lr1)
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("I" & Lr1), Address:="", SubAddress:="'" & Sheets("Work").Name & "'!" & Cr1R, TextToDisplay:=Range("I" & Lr1).Value
    Application.EnableEvents = True
   End If
  End If
    If Not Intersect(Target, Range("N" & Lr2)) Is Nothing Then
   If Target.Count = 1 Then
    Application.EnableEvents = False
     Range("N" & Lr2 & ":Q" & Lr2).Insert Shift:=xlDown
     Range("N" & Lr2).Value = Sheets("Paper").Range("A" & (Lr2 - 3) * 6 + 1).Value
     Cr2 = Application.WorksheetFunction.Match(Range("N" & Lr2).Value, Sheets("Paper").Range("A1:A" & Lr4), 0)
     Cr2R = Range("A" & Cr2).Address
     Range("O" & Lr2 - 1 & ":Q" & Lr2 - 1).AutoFill Destination:=Range("O" & Lr2 - 1 & ":Q" & Lr2)
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("N" & Lr2), Address:="", SubAddress:="'" & Sheets("Paper").Name & "'!" & Cr2R, TextToDisplay:=Range("N" & Lr2).Value
    Application.EnableEvents = True
   End If
  End If
End Sub
Click to expand...
yeah that is correct except find last customer, this is wrong give data, i write name in every sheet in colored cell (in work green and in paper blue but may i create another sheet and use different color) can this help to find?
 
Upvote 0
Unexpc said:
except find last customer, this is wrong give data
Click to expand...
I don't understand what you want exactly. I modify code to don't add new row when you reach new customer at work OR Paper Sheet.
2. If you want add new sheet to your sources, then where (columns) you want to have customer names on it? for e.g. columns S to V
3. Then you should add Lr5 for find last row number at column S then Lr6 to find last row number at source sheet and one part of Complete Intersect for that sheet.
4. if you want add customer names for all sheets except dashboard we can use another method.
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long, j As Long, Lr1 As Long, Lr2 As Long, Cr1 As Long, Cr1R As String, Cr2 As Long, Cr2R As String
Dim Lr3 As Long, Lr4 As Long, F1 As Long, F2 As Long
Lr1 = Range("I" & Rows.Count).End(xlUp).Row
Lr2 = Range("N" & Rows.Count).End(xlUp).Row
Lr3 = Sheets("Work").Range("A" & Rows.Count).End(xlUp).Row
Lr4 = Sheets("Paper").Range("A" & Rows.Count).End(xlUp).Row

On Error Resume Next
  F1 = (Lr1 - 3) * 6 + 4
  F2 = (Lr2 - 3) * 6 + 4
  If F1 > Lr3 Then GoTo NextC
  If Not Intersect(Target, Range("I" & Lr1)) Is Nothing Then
   If Target.Count = 1 Then
    Application.EnableEvents = False
     Range("I" & Lr1 & ":M" & Lr1).Insert Shift:=xlDown
     Range("I" & Lr1).Value = Sheets("Work").Range("A" & (Lr1 - 3) * 6 + 1).Value
     Cr1 = Application.WorksheetFunction.Match(Range("I" & Lr1).Value, Sheets("Work").Range("A1:A" & Lr3), 0)
     Cr1R = Range("A" & Cr1).Address
     Range("J" & Lr1 - 1 & ":L" & Lr1 - 1).AutoFill Destination:=Range("J" & Lr1 - 1 & ":L" & Lr1)
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("I" & Lr1), Address:="", SubAddress:="'" & Sheets("Work").Name & "'!" & Cr1R, TextToDisplay:=Range("I" & Lr1).Value
    Application.EnableEvents = True
   End If
  End If
NextC:
  If F2 > Lr4 Then GoTo NextD
    If Not Intersect(Target, Range("N" & Lr2)) Is Nothing Then
   If Target.Count = 1 Then
    Application.EnableEvents = False
     Range("N" & Lr2 & ":Q" & Lr2).Insert Shift:=xlDown
     Range("N" & Lr2).Value = Sheets("Paper").Range("A" & (Lr2 - 3) * 6 + 1).Value
     Cr2 = Application.WorksheetFunction.Match(Range("N" & Lr2).Value, Sheets("Paper").Range("A1:A" & Lr4), 0)
     Cr2R = Range("A" & Cr2).Address
     Range("O" & Lr2 - 1 & ":Q" & Lr2 - 1).AutoFill Destination:=Range("O" & Lr2 - 1 & ":Q" & Lr2)
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("N" & Lr2), Address:="", SubAddress:="'" & Sheets("Paper").Name & "'!" & Cr2R, TextToDisplay:=Range("N" & Lr2).Value
    Application.EnableEvents = True
   End If
  End If
NextD:
If Not Intersect(Target, Range("I" & Lr1)) Is Nothing Then If F1 > Lr3 Then MsgBox "You should First Input New Customer at Destination Sheet"
If Not Intersect(Target, Range("N" & Lr2)) Is Nothing Then If F2 > Lr4 Then MsgBox "You should First Input New Customer at Destination Sheet"
End Sub
 
Upvote 0
maabadi said:
I don't understand what you want exactly. I modify code to don't add new row when you reach new customer at work OR Paper Sheet.
2. If you want add new sheet to your sources, then where (columns) you want to have customer names on it? for e.g. columns S to V
3. Then you should add Lr5 for find last row number at column S then Lr6 to find last row number at source sheet and one part of Complete Intersect for that sheet.
4. if you want add customer names for all sheets except dashboard we can use another method.
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long, j As Long, Lr1 As Long, Lr2 As Long, Cr1 As Long, Cr1R As String, Cr2 As Long, Cr2R As String
Dim Lr3 As Long, Lr4 As Long, F1 As Long, F2 As Long
Lr1 = Range("I" & Rows.Count).End(xlUp).Row
Lr2 = Range("N" & Rows.Count).End(xlUp).Row
Lr3 = Sheets("Work").Range("A" & Rows.Count).End(xlUp).Row
Lr4 = Sheets("Paper").Range("A" & Rows.Count).End(xlUp).Row

On Error Resume Next
  F1 = (Lr1 - 3) * 6 + 4
  F2 = (Lr2 - 3) * 6 + 4
  If F1 > Lr3 Then GoTo NextC
  If Not Intersect(Target, Range("I" & Lr1)) Is Nothing Then
   If Target.Count = 1 Then
    Application.EnableEvents = False
     Range("I" & Lr1 & ":M" & Lr1).Insert Shift:=xlDown
     Range("I" & Lr1).Value = Sheets("Work").Range("A" & (Lr1 - 3) * 6 + 1).Value
     Cr1 = Application.WorksheetFunction.Match(Range("I" & Lr1).Value, Sheets("Work").Range("A1:A" & Lr3), 0)
     Cr1R = Range("A" & Cr1).Address
     Range("J" & Lr1 - 1 & ":L" & Lr1 - 1).AutoFill Destination:=Range("J" & Lr1 - 1 & ":L" & Lr1)
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("I" & Lr1), Address:="", SubAddress:="'" & Sheets("Work").Name & "'!" & Cr1R, TextToDisplay:=Range("I" & Lr1).Value
    Application.EnableEvents = True
   End If
  End If
NextC:
  If F2 > Lr4 Then GoTo NextD
    If Not Intersect(Target, Range("N" & Lr2)) Is Nothing Then
   If Target.Count = 1 Then
    Application.EnableEvents = False
     Range("N" & Lr2 & ":Q" & Lr2).Insert Shift:=xlDown
     Range("N" & Lr2).Value = Sheets("Paper").Range("A" & (Lr2 - 3) * 6 + 1).Value
     Cr2 = Application.WorksheetFunction.Match(Range("N" & Lr2).Value, Sheets("Paper").Range("A1:A" & Lr4), 0)
     Cr2R = Range("A" & Cr2).Address
     Range("O" & Lr2 - 1 & ":Q" & Lr2 - 1).AutoFill Destination:=Range("O" & Lr2 - 1 & ":Q" & Lr2)
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Range("N" & Lr2), Address:="", SubAddress:="'" & Sheets("Paper").Name & "'!" & Cr2R, TextToDisplay:=Range("N" & Lr2).Value
    Application.EnableEvents = True
   End If
  End If
NextD:
If Not Intersect(Target, Range("I" & Lr1)) Is Nothing Then If F1 > Lr3 Then MsgBox "You should First Input New Customer at Destination Sheet"
If Not Intersect(Target, Range("N" & Lr2)) Is Nothing Then If F2 > Lr4 Then MsgBox "You should First Input New Customer at Destination Sheet"
End Sub
Click to expand...
i don't understand completely, but what i want: at first this photo i uploaded should be in after last customer of each two sheet work and paper (with in different color green and blue, see in file), when i want add a customer, first copy this specific rows (rows in photo) and paste after that, and in new customer cell, i write customer name and after that write data about it, then i select new customer in dashboard that added customer name in customer list in dashboard...
simple and better function i think, with first code you send, everything is ok except customer name, for this anyway when i select new customer in dashboard and write a name on new cell in upper new customer, that is automatically insert in this formula
for Work
=HYPERLINK("#'Work'!A"&MATCH("Customer Name i write",Work!A:A,0),"Customer Name i write")
for Paper
=HYPERLINK("#'Paper'!A"&MATCH("Customer Name i write",Paper!A:A,0),"Customer Name i write")
and if can, copy specific rows (rows in photo) in Work or Paper (find out witch sheet with sheet name in hyperlink) and paste after that and insert customer name i write...
i hope say better than before :)
 

Attachments

  • image_2021-04-04_131310.png
    image_2021-04-04_131310.png
    5.7 KB · Views: 4
Upvote 0
I cannot enter hyperlink formula within VBA because it have problem with "#" symbol.
what is problem with my last code? it hyperlinked to your sheet & other formula also copied.
 
Upvote 0
maabadi said:
I cannot enter hyperlink formula within VBA because it have problem with "#" symbol.
what is problem with my last code? it hyperlinked to your sheet & other formula also copied.
Click to expand...
this not ok give wrong drag and fill and disordered last customer after i select new customer and wrong give hyperlink
 
Upvote 0
maabadi said:
I cannot enter hyperlink formula within VBA because it have problem with "#" symbol.
what is problem with my last code? it hyperlinked to your sheet & other formula also copied.
Click to expand...
can you write code that find last colored cell before new customer cell in work and paper?
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question
VBA - add formula to cell when created
Replies
2
Views
302
Golaidron
G
I
  • Question
Copy worksheet but the new worksheet to omit some items
2
Replies
11
Views
460
ipbr21054
I
szita2000
  • Question
Index Match Match from a named table to a range
Replies
1
Views
335
Alex Blakenburg
A
B
  • Question
Copy formula into a cell using vba
2
Replies
11
Views
449
BobtBuilder
B
G
  • Solved
Extract the cells that contains alphanumeric string from the column
Replies
6
Views
373
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,215,261
Messages
6,123,931
Members
449,134
Latest member
NickWBA

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top