Macro to have 1 activeXButton instead of 48 activeXButtons

Phixtit

Phixtit

Active Member
Joined
Oct 23, 2008
Messages
346
I have 48 activeX Buttons on my sheet that when individually clicked, data such as scores are copied to my database sheet.
There are up to 48 players, each with a button beside the players name.
Right now I have to click on each button to have my data transfer to my database.
I would like to have only 1 activeX Button that when clicked it would add only players with data to database. So that, if there are NOT all 48 players it would only copy the data if the Player has a name for example. So that if there are lets say 32 players that the other 16 empty scores would NOT be copied to the database.

Any ideas?

Below is my current code:
Code: 
Private Sub CommandButton1_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BC401:BC435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton1.BackColor = vbGreen Then
CommandButton1.BackColor = vbBlue
Else
CommandButton1.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton2_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BD401:BD435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton2.BackColor = vbGreen Then
CommandButton2.BackColor = vbBlue
Else
CommandButton2.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton3_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BE401:BE435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton3.BackColor = vbGreen Then
CommandButton3.BackColor = vbBlue
Else
CommandButton3.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton4_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BF401:BF435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton4.BackColor = vbGreen Then
CommandButton4.BackColor = vbBlue
Else
CommandButton4.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton5_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BG401:BG435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton5.BackColor = vbGreen Then
CommandButton5.BackColor = vbBlue
Else
CommandButton5.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton6_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BH401:BH435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton6.BackColor = vbGreen Then
CommandButton6.BackColor = vbBlue
Else
CommandButton6.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton7_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BI401:BI435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton7.BackColor = vbGreen Then
CommandButton7.BackColor = vbBlue
Else
CommandButton7.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton8_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BJ401:BJ435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton8.BackColor = vbGreen Then
CommandButton8.BackColor = vbBlue
Else
CommandButton8.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton9_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BK401:BK435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton9.BackColor = vbGreen Then
CommandButton9.BackColor = vbBlue
Else
CommandButton9.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton10_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BL401:BL435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton10.BackColor = vbGreen Then
CommandButton10.BackColor = vbBlue
Else
CommandButton10.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton11_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BM401:BM435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton11.BackColor = vbGreen Then
CommandButton11.BackColor = vbBlue
Else
CommandButton11.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton12_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BN401:BN435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton12.BackColor = vbGreen Then
CommandButton12.BackColor = vbBlue
Else
CommandButton12.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton13_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BO401:BO435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton13.BackColor = vbGreen Then
CommandButton13.BackColor = vbBlue
Else
CommandButton13.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton14_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BP401:BP435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton14.BackColor = vbGreen Then
CommandButton14.BackColor = vbBlue
Else
CommandButton14.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton15_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BQ401:BQ435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton15.BackColor = vbGreen Then
CommandButton15.BackColor = vbBlue
Else
CommandButton15.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton16_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BR401:BR435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton16.BackColor = vbGreen Then
CommandButton16.BackColor = vbBlue
Else
CommandButton16.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton17_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BS401:BS435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton17.BackColor = vbGreen Then
CommandButton17.BackColor = vbBlue
Else
CommandButton17.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton18_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BT401:BT435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton18.BackColor = vbGreen Then
CommandButton18.BackColor = vbBlue
Else
CommandButton18.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton19_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BU401:BU435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton19.BackColor = vbGreen Then
CommandButton19.BackColor = vbBlue
Else
CommandButton19.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton20_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BV401:BV435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton20.BackColor = vbGreen Then
CommandButton20.BackColor = vbBlue
Else
CommandButton20.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton21_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BW401:BW435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton21.BackColor = vbGreen Then
CommandButton21.BackColor = vbBlue
Else
CommandButton21.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton22_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BX401:BX435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton22.BackColor = vbGreen Then
CommandButton22.BackColor = vbBlue
Else
CommandButton22.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton23_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BY401:BY435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton23.BackColor = vbGreen Then
CommandButton23.BackColor = vbBlue
Else
CommandButton23.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton24_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("BZ401:BZ435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton24.BackColor = vbGreen Then
CommandButton24.BackColor = vbBlue
Else
CommandButton24.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton25_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CA401:CA435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton25.BackColor = vbGreen Then
CommandButton25.BackColor = vbBlue
Else
CommandButton25.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton26_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CB401:CB435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton26.BackColor = vbGreen Then
CommandButton26.BackColor = vbBlue
Else
CommandButton26.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton27_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CC401:CC435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton27.BackColor = vbGreen Then
CommandButton27.BackColor = vbBlue
Else
CommandButton27.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton28_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CD401:CD435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton28.BackColor = vbGreen Then
CommandButton28.BackColor = vbBlue
Else
CommandButton28.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton29_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CE401:CE435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton29.BackColor = vbGreen Then
CommandButton29.BackColor = vbBlue
Else
CommandButton29.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton30_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CF401:CF435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton30.BackColor = vbGreen Then
CommandButton30.BackColor = vbBlue
Else
CommandButton30.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton31_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CG401:CG435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton31.BackColor = vbGreen Then
CommandButton31.BackColor = vbBlue
Else
CommandButton31.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton32_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CH401:CH435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton32.BackColor = vbGreen Then
CommandButton32.BackColor = vbBlue
Else
CommandButton32.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton33_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CI401:CI435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton33.BackColor = vbGreen Then
CommandButton33.BackColor = vbBlue
Else
CommandButton33.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton34_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CJ401:CJ435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton34.BackColor = vbGreen Then
CommandButton34.BackColor = vbBlue
Else
CommandButton34.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton35_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CK401:CK435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton35.BackColor = vbGreen Then
CommandButton35.BackColor = vbBlue
Else
CommandButton35.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton36_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CL401:CL435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton36.BackColor = vbGreen Then
CommandButton36.BackColor = vbBlue
Else
CommandButton36.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton37_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CM401:CM435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton37.BackColor = vbGreen Then
CommandButton37.BackColor = vbBlue
Else
CommandButton37.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton38_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CN401:CN435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton38.BackColor = vbGreen Then
CommandButton38.BackColor = vbBlue
Else
CommandButton38.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton39_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CO401:CO435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton39.BackColor = vbGreen Then
CommandButton39.BackColor = vbBlue
Else
CommandButton39.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton40_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CP401:CP435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton40.BackColor = vbGreen Then
CommandButton40.BackColor = vbBlue
Else
CommandButton40.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton41_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CQ401:CQ435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton41.BackColor = vbGreen Then
CommandButton41.BackColor = vbBlue
Else
CommandButton41.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton42_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CR401:CR435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton42.BackColor = vbGreen Then
CommandButton42.BackColor = vbBlue
Else
CommandButton42.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton43_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CS401:CS435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton43.BackColor = vbGreen Then
CommandButton43.BackColor = vbBlue
Else
CommandButton43.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton44_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CT401:CT435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton44.BackColor = vbGreen Then
CommandButton44.BackColor = vbBlue
Else
CommandButton44.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton45_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CU401:CU435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton45.BackColor = vbGreen Then
CommandButton45.BackColor = vbBlue
Else
CommandButton45.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton46_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CV401:CV435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton46.BackColor = vbGreen Then
CommandButton46.BackColor = vbBlue
Else
CommandButton46.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton47_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CW401:CW435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton47.BackColor = vbGreen Then
CommandButton47.BackColor = vbBlue
Else
CommandButton47.BackColor = vbGreen
End If
End Sub
Private Sub CommandButton48_Click()
    Dim destrange As Range
    Dim smallrng As Range
    Application.ScreenUpdating = False
    For Each smallrng In Sheets("Scorecard"). _
        Range("CX401:CX435").Areas
        Set destrange = Sheets("database").Range("A" & _
                        LastRow(Sheets("database")) + 1)
        smallrng.Copy
        destrange.PasteSpecial xlPasteValues, , False, True
        Application.CutCopyMode = False
    Next smallrng
    Application.ScreenUpdating = True
 
    If CommandButton48.BackColor = vbGreen Then
CommandButton48.BackColor = vbBlue
Else
CommandButton48.BackColor = vbGreen
End If
End Sub
Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=True).Row
    On Error GoTo 0
End Function
 
Sort by date Sort by votes
Andrew Poulsom said:
Which cell(s) would be empty if the player had no score?
Click to expand...

Below shows which cells would be empty for each of the 48 Players:
Code: 
If Player 1 had no score: BC401:BC435 would be empty
If Player 2 had no score: BD401:BD435 would be empty
If Player 3 had no score: BE401:BE435 would be empty
If Player 4 had no score: BF401:BF435 would be empty
If Player 5 had no score: BG401:BG435 would be empty
If Player 6 had no score: BH401:BH435 would be empty
If Player 7 had no score: BI401:BI435 would be empty
If Player 8 had no score: BJ401:BJ435 would be empty
If Player 9 had no score: BK401:BK435 would be empty
If Player 10 had no score: BL401:BL435 would be empty
If Player 11 had no score: BM401:BM435 would be empty
If Player 12 had no score: BN401:BN435 would be empty
If Player 13 had no score: BO401:BO435 would be empty
If Player 14 had no score: BP401:BP435 would be empty
If Player 15 had no score: BQ401:BQ435 would be empty
If Player 16 had no score: BR401:BR435 would be empty
If Player 17 had no score: BS401:BS435 would be empty
If Player 18 had no score: BT401:BT435 would be empty
If Player 19 had no score: BU401:BU435 would be empty
If Player 20 had no score: BV401:BV435 would be empty
If Player 21 had no score: BW401:BW435 would be empty
If Player 22 had no score: BX401:BX435 would be empty
If Player 23 had no score: BY401:BY435 would be empty
If Player 24 had no score: BZ401:BZ435 would be empty
If Player 25 had no score: CA401:CA435 would be empty
If Player 26 had no score: CB401:CB435 would be empty
If Player 27 had no score: CC401:CC435 would be empty
If Player 28 had no score: CD401:CD435 would be empty
If Player 29 had no score: CE401:CE435 would be empty
If Player 30 had no score: CF401:CF435 would be empty
If Player 31 had no score: CG401:CG435 would be empty
If Player 32 had no score: CH401:CH435 would be empty
If Player 33 had no score: CI401:CI435 would be empty
If Player 34 had no score: CJ401:CJ435 would be empty
If Player 35 had no score: CK401:CK435 would be empty
If Player 36 had no score: CL401:CL435 would be empty
If Player 37 had no score: CM401:CM435 would be empty
If Player 38 had no score: CN401:CN435 would be empty
If Player 39 had no score: CO401:CO435 would be empty
If Player 40 had no score: CP401:CP435 would be empty
If Player 41 had no score: CQ401:CQ435 would be empty
If Player 42 had no score: CR401:CR435 would be empty
If Player 43 had no score: CS401:CS435 would be empty
If Player 44 had no score: CT401:CT435 would be empty
If Player 45 had no score: CU401:CU435 would be empty
If Player 46 had no score: CV401:CV435 would be empty
If Player 47 had no score: CW401:CW435 would be empty
If Player 48 had no score: CX401:CX435 would be empty
 
Upvote 0
Try:

Code: 
Private Sub CommandButton1_Click()
    Dim bigrng As Range
    Dim smallrng As Range
    Dim destrange As Range
    Application.ScreenUpdating = False
    For Each bigrng In Sheets("Scorecard").Range("BC401:CX435").Columns
        For Each smallrng In bigrng
            If Not IsEmpty(smallrng.Cells(1, 1)) Then
                Set destrange = Sheets("database").Range("A" & _
                    LastRow(Sheets("database")) + 1)
                smallrng.Copy
                destrange.PasteSpecial xlPasteValues, , False, True
                Application.CutCopyMode = False
            End If
        Next smallrng
    Next bigrng
    Application.ScreenUpdating = True
    If CommandButton1.BackColor = vbGreen Then
        CommandButton1.BackColor = vbBlue
    Else
        CommandButton1.BackColor = vbGreen
    End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question Question
Excel VB UserForm - Change CommandButton BackColor after click in my Userform - change back to standardColor after click again...
2
Replies
18
Views
288
DanteAmor
DanteAmor
yearego021
  • Solved
VBA to Save as PDF broken with unwanted deleting of tabs.
Replies
7
Views
258
Artik
Artik
J
  • Question Question
Userform inconsistent responses
Replies
1
Views
276
Candyman8019
C
K
  • Question Question
How to shorten vba code without any problems
Replies
1
Views
315
kamranyd
K
O
  • Solved
ActiveX checkbox that changes color
2
Replies
15
Views
1K
John_w
J

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