When cell is clicked, change value of cells.

A

adurham22926192

New Member
Joined
Dec 17, 2019
Messages
49
Office Version
  1. 2019
Platform
  1. Windows
SHEET 1ABCDEF
1NumberRound TotalPlace
2
3NumberRound 1Round 2Round 3TotalPlace
412862582658092nd
522723002938651st
6
7

SHEET 2ABCDE
1No.Ms Kelley MooreMs Lorraine Heaney BoyleMs Carol CarberryTotal
2110086100286
328610086272

SHEET 3ABCDE
1No.Ms Patricia Kennedy CadwellMr Michael O'HaraMs Sheila NolanTotal
21868686258
32100100100300

SHEET 4ABCDE
1No.Ms Mary ByrneMs Helen MountaineMr Brendan McKennaTotal
21869386265
3210093100293

When I click cell B4 on SHEET 1, I want the range B1:D1 from SHEET 2 to appear in B1:D1 on SHEET 1. Then when I click on C4 on SHEET 1, I want the range B1:D1 from SHEET 1 to change to the range B1:D1 on SHEET 3. And lastly, when I click on D4 on SHEET 1, I want the range B1:D1 from SHEET 1 to change to the range B1:D1 on SHEET 4.

Hope this makes sense. I need help ASAP!
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Sort by date Sort by votes
Macro under Sheet1 module

VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet

Set ws2 = ActiveWorkbook.Sheets("Sheet2")
Set ws3 = ActiveWorkbook.Sheets("Sheet3")
Set ws4 = ActiveWorkbook.Sheets("Sheet4")

If Not Intersect(Target, Union(Range("B4", "B5"), Range("C4", "C5"), Range("D4", "D5"))) Is Nothing Then
    Select Case Target.Column
        Case 2
            ws2.Range("B1", "D1").Copy Range("B1")
        Case 3
            ws3.Range("B1", "D1").Copy Range("B1")
        Case 4
            ws4.Range("B1", "D1").Copy Range("B1")
    End Select
End If

End Sub
 
Upvote 0
I actually have inserted 2 rows above what was A1 so now that cell is A3 not A1. When I put in the code, it says "We cannot do that to a merged cell".
Zot said:
Macro under Sheet1 module

VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet

Set ws2 = ActiveWorkbook.Sheets("Sheet2")
Set ws3 = ActiveWorkbook.Sheets("Sheet3")
Set ws4 = ActiveWorkbook.Sheets("Sheet4")

If Not Intersect(Target, Union(Range("B4", "B5"), Range("C4", "C5"), Range("D4", "D5"))) Is Nothing Then
    Select Case Target.Column
        Case 2
            ws2.Range("B1", "D1").Copy Range("B1")
        Case 3
            ws3.Range("B1", "D1").Copy Range("B1")
        Case 4
            ws4.Range("B1", "D1").Copy Range("B1")
    End Select
End If

End Sub
Click to expand...
 
Upvote 0
So you just need to adjust accordingly. This is only for Sheet1, right?
VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet

Set ws2 = ActiveWorkbook.Sheets("Sheet2")
Set ws3 = ActiveWorkbook.Sheets("Sheet3")
Set ws4 = ActiveWorkbook.Sheets("Sheet4")

If Not Intersect(Target, Union(Range("B6", "B7"), Range("C6", "C7"), Range("D6", "D7"))) Is Nothing Then
    Select Case Target.Column
        Case 2
            ws2.Range("B1", "D1").Copy Range("B3")
        Case 3
            ws3.Range("B1", "D1").Copy Range("B3")
        Case 4
            ws4.Range("B1", "D1").Copy Range("B3")
    End Select
End If

End Sub
 
Upvote 0
Solution
This code works perfectly! One last thing I forgot to say was in F2 on SHEET 1, I want it to rank what is in E2 on SHEET 2. But there are some conditions:

When I click on any cell from B4:B44, I want it to rank E2 compared against B4:B44. The formula I have in F2 is =IF(E2>0,SUMPRODUCT((E2<=$E$4:$E$44)/COUNTIF($E$4:$E$44,$E$4:$E$44)),"") but this only works for Round 1.

Basically, what I would like is when I click any cell from B4:B44, it will rank E2 against the range B4:B44 and return the rank in cell F2 but if I click a cell from C4:C44, it will rank E2 against the range C4:C44 and lastly, if I click a cell from D4:D44, it will rank E2 against D4:D44.

Hope this makes sense.
 
Upvote 0
I cannot understand. Before this you said you added 2 rows that A1 not become A3. So, why you click range is B4:B44? Sounds like before modification.

In F2 Sheet1 you want to rank with E2 value? The E2 sheet2 is total column?

You should have used XL2BB to paste your sheets. Using XL2BB also can let helpers to see you formula inside cell as well.
 
Upvote 0
Zot said:
I cannot understand. Before this you said you added 2 rows that A1 not become A3. So, why you click range is B4:B44? Sounds like before modification.

In F2 Sheet1 you want to rank with E2 value? The E2 sheet2 is total column?

You should have used XL2BB to paste your sheets. Using XL2BB also can let helpers to see you formula inside cell as well.
Click to expand...
It won’t let me download XL2BB. I’ll say what I said before but with the updated cell ranges.

This code works perfectly! One last thing I forgot to say was in F4 on SHEET 1, I want it to rank what is in E4 on SHEET 1. But there are some conditions:

When I click on any cell from B6:B44, I want it to rank E4 compared against B6:B44. The formula I have in F4 is =IF(E4>0,SUMPRODUCT((E4<=$E$6:$E$44)/COUNTIF($E$6:$E$44,$E$6:$E$44)),"") but this only works for Round 1.

Basically, what I would like is when I click any cell from B6:B44, it will rank E4 against the range B6:B44 and return the rank in cell F4 but if I click a cell from C6:C44, it will rank E4 against the range C6:C44 and lastly, if I click a cell from D6:D44, it will rank E4 against D6:D44.

All of the ranges and everything are on SHEET 1 not SHEET 2. SHEET 2 has nothing to do with this. That’s why when I said SHEET 2 by accident in my last post, you were probably confused lol

Hope this makes sense
 
Upvote 0
Sorry for late reply. I was extremely busy and only read your description again during weekend.

This is how the Sheet1 looks like. Added few line to test.

Another VLookUp.xlsm
ABCDEF
1
2
3NumberMs Kelley MooreMs Lorraine Heaney BoyleMs Carol CarberryRound TotalPlace
405th
5NumberRound 1Round 2Round 3TotalPlace
612862582658092nd
722723002938651st
8700680456
9800900567
Sheet1
Cell Formulas
RangeFormula
E4E4=SUM(B4:D4)


The other Sheet 2, 3 and 4 hav no change.

Here is the code. I'm using QuickSort in reverse order to get the rank

VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim n&, Place&, eRow&
Dim strPlace$
Dim ArryRank()
Dim ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet

Set ws2 = ActiveWorkbook.Sheets("Sheet2")
Set ws3 = ActiveWorkbook.Sheets("Sheet3")
Set ws4 = ActiveWorkbook.Sheets("Sheet4")

If Not Intersect(Target, Union(Range("B6", "B44"), Range("C6", "C44"), Range("D6", "D44"))) Is Nothing Then
Application.EnableEvents = False
    Select Case Target.Column
        Case 2
            ws2.Range("B1", "D1").Copy Range("B3")
            eRow = Cells(Rows.Count, "B").End(xlUp).Row
            ArryRank = Application.WorksheetFunction.Transpose(Range("B6", "B" & eRow))
            ReDim Preserve ArryRank(1 To UBound(ArryRank) + 1)
            ArryRank(UBound(ArryRank)) = Range("E4")
        Case 3
            ws3.Range("B1", "D1").Copy Range("B3")
            eRow = Cells(Rows.Count, "C").End(xlUp).Row
            ArryRank = Application.WorksheetFunction.Transpose(Range("C6", "C" & eRow))
            ReDim Preserve ArryRank(1 To UBound(ArryRank) + 1)
            ArryRank(UBound(ArryRank)) = Range("E4")
        Case 4
            ws4.Range("B1", "D1").Copy Range("B3")
            eRow = Cells(Rows.Count, "D").End(xlUp).Row
            ReDim ArryRank(1 To eRow - 4)
            ArryRank = Application.WorksheetFunction.Transpose(Range("D6", "D" & eRow))
            ReDim Preserve ArryRank(1 To UBound(ArryRank) + 1)
            ArryRank(UBound(ArryRank)) = Range("E4")
    End Select

    Call QuickSortRank(ArryRank, LBound(ArryRank), UBound(ArryRank))
    Place = Application.WorksheetFunction.Match(Range("E4"), ArryRank, 0)

    Select Case Place
        Case 1
            Range("F4") = "1st"
        Case 2
            Range("F4") = "2nd"
        Case 3
            Range("F4") = "3rd"
        Case Else
            Range("F4") = Place & "th"
    End Select
    Application.EnableEvents = True
End If

End Sub

Private Sub QuickSortRank(arr() As Variant, inLow As Long, inHi As Long)

Dim pivot&, tmpSwap&, tmpLow&, tmpHi&

tmpLow = inLow
tmpHi = inHi

pivot = arr((inLow + inHi) \ 2)

Do While (tmpLow <= tmpHi)
    Do While arr(tmpLow) > pivot And tmpLow < inHi   'decending
        tmpLow = tmpLow + 1
    Loop

    Do While pivot > arr(tmpHi) And tmpHi > inLow   'decending
        tmpHi = tmpHi - 1
    Loop

    If tmpLow <= tmpHi Then
        tmpSwap = arr(tmpLow)
        arr(tmpLow) = arr(tmpHi)
        arr(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
    End If
Loop

If inLow < tmpHi Then QuickSortRank arr, inLow, tmpHi
If tmpLow < inHi Then QuickSortRank arr, tmpLow, inHi

End Sub
 
Upvote 0
adurham22926192 said:
It won’t let me download XL2BB. I’ll say what I said before but with the updated cell ranges.

This code works perfectly! One last thing I forgot to say was in F4 on SHEET 1, I want it to rank what is in E4 on SHEET 1. But there are some conditions:

When I click on any cell from B6:B44, I want it to rank E4 compared against B6:B44. The formula I have in F4 is =IF(E4>0,SUMPRODUCT((E4<=$E$6:$E$44)/COUNTIF($E$6:$E$44,$E$6:$E$44)),"") but this only works for Round 1.

Basically, what I would like is when I click any cell from B6:B44, it will rank E4 against the range B6:B44 and return the rank in cell F4 but if I click a cell from C6:C44, it will rank E4 against the range C6:C44 and lastly, if I click a cell from D6:D44, it will rank E4 against D6:D44.

All of the ranges and everything are on SHEET 1 not SHEET 2. SHEET 2 has nothing to do with this. That’s why when I said SHEET 2 by accident in my last post, you were probably confused lol

Hope this makes sense
Click to expand...
T
Zot said:
Sorry for late reply. I was extremely busy and only read your description again during weekend.

This is how the Sheet1 looks like. Added few line to test.

Another VLookUp.xlsm
ABCDEF
1
2
3NumberMs Kelley MooreMs Lorraine Heaney BoyleMs Carol CarberryRound TotalPlace
405th
5NumberRound 1Round 2Round 3TotalPlace
612862582658092nd
722723002938651st
8700680456
9800900567
Sheet1
Cell Formulas
RangeFormula
E4E4=SUM(B4:D4)


The other Sheet 2, 3 and 4 hav no change.

Here is the code. I'm using QuickSort in reverse order to get the rank

VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim n&, Place&, eRow&
Dim strPlace$
Dim ArryRank()
Dim ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet

Set ws2 = ActiveWorkbook.Sheets("Sheet2")
Set ws3 = ActiveWorkbook.Sheets("Sheet3")
Set ws4 = ActiveWorkbook.Sheets("Sheet4")

If Not Intersect(Target, Union(Range("B6", "B44"), Range("C6", "C44"), Range("D6", "D44"))) Is Nothing Then
Application.EnableEvents = False
    Select Case Target.Column
        Case 2
            ws2.Range("B1", "D1").Copy Range("B3")
            eRow = Cells(Rows.Count, "B").End(xlUp).Row
            ArryRank = Application.WorksheetFunction.Transpose(Range("B6", "B" & eRow))
            ReDim Preserve ArryRank(1 To UBound(ArryRank) + 1)
            ArryRank(UBound(ArryRank)) = Range("E4")
        Case 3
            ws3.Range("B1", "D1").Copy Range("B3")
            eRow = Cells(Rows.Count, "C").End(xlUp).Row
            ArryRank = Application.WorksheetFunction.Transpose(Range("C6", "C" & eRow))
            ReDim Preserve ArryRank(1 To UBound(ArryRank) + 1)
            ArryRank(UBound(ArryRank)) = Range("E4")
        Case 4
            ws4.Range("B1", "D1").Copy Range("B3")
            eRow = Cells(Rows.Count, "D").End(xlUp).Row
            ReDim ArryRank(1 To eRow - 4)
            ArryRank = Application.WorksheetFunction.Transpose(Range("D6", "D" & eRow))
            ReDim Preserve ArryRank(1 To UBound(ArryRank) + 1)
            ArryRank(UBound(ArryRank)) = Range("E4")
    End Select

    Call QuickSortRank(ArryRank, LBound(ArryRank), UBound(ArryRank))
    Place = Application.WorksheetFunction.Match(Range("E4"), ArryRank, 0)

    Select Case Place
        Case 1
            Range("F4") = "1st"
        Case 2
            Range("F4") = "2nd"
        Case 3
            Range("F4") = "3rd"
        Case Else
            Range("F4") = Place & "th"
    End Select
    Application.EnableEvents = True
End If

End Sub

Private Sub QuickSortRank(arr() As Variant, inLow As Long, inHi As Long)

Dim pivot&, tmpSwap&, tmpLow&, tmpHi&

tmpLow = inLow
tmpHi = inHi

pivot = arr((inLow + inHi) \ 2)

Do While (tmpLow <= tmpHi)
    Do While arr(tmpLow) > pivot And tmpLow < inHi   'decending
        tmpLow = tmpLow + 1
    Loop

    Do While pivot > arr(tmpHi) And tmpHi > inLow   'decending
        tmpHi = tmpHi - 1
    Loop

    If tmpLow <= tmpHi Then
        tmpSwap = arr(tmpLow)
        arr(tmpLow) = arr(tmpHi)
        arr(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
    End If
Loop

If inLow < tmpHi Then QuickSortRank arr, inLow, tmpHi
If tmpLow < inHi Then QuickSortRank arr, tmpLow, inHi

End Sub
Click to expand...
This code is perfect but I forgot to say that I want just the number rank so without the (st, nd, th) on the end so like instead of 5th it would be 5
 
Upvote 0
Then you just remove this portion

VBA Code: 
Select Case Place
     Case 1
         Range("F4") = "1st"
     Case 2
         Range("F4") = "2nd"
     Case 3
         Range("F4") = "3rd"
     Case Else
         Range("F4") = Place & "th"
 End Select

and replace with just

Range("F4") = Place
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
Summing Values
Replies
3
Views
213
LazyBug
LazyBug
ExcelNewbie2020
  • Question
Percentage Allocation Variance
Replies
7
Views
183
Joe4
Joe4
S
  • Question
Row Customers, Column Stock, Click deliver button add quantity in cell, and transfer all details to new sheet to new line as Sales order line.
Replies
0
Views
293
stavrosiona
S
E
  • Question
VB Help with code to copy selected rows to specified cells in another sheet.
2
Replies
12
Views
396
Excel_Assis
E
Romano_odK
  • Solved
How to remove al line with VBA when the values is "OK"
Replies
9
Views
253
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,943
Messages
6,122,370
Members
449,080
Latest member
Armadillos

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