vba need help referencing other cells

K

Kelly05201

New Member
Joined
Jun 17, 2016
Messages
29
Hello all.. learning this vba stuff one google search at a time is tough! I'm knee deep into a project that's well beyond my skill set.. but learning fast. The trouble I'm having is how to reference other cells in proper syntax.. and understanding how to specify a range... can someone get me on the right track?
Workbook for my horse club.
My code so far:
Code: 
Private Sub Worksheet_SelectionChange(ByVal target As Range)
On Error Resume Next
If Not Intersect(target, Range("A2:L70")) Is Nothing Then
    Dim SheetTarget As Worksheet
    Dim Registration As Worksheet
    Dim HorseNumber As Range
    Dim cell As Range
    Dim EntryVerified As Boolean
    
    Const RegistrationName = "Registration"
    
    Dim LastRow As Long
    LastRow = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    
        For Each cell In Registration.Range("F2:L70") 'test each cell for exisitng matches on TargetSheet
            SheetTarget = ""
            If IsEmpty(cell) = False Then 'rider has entered that event, cell value indicates division
                SheetTarget = cell.Value & " " '& [value of row 1 @ same column]
                'CHECK FOR AN EXACT MATCH ON TargetSheet OF ALL: HORSE NUMBER ("D"), FIRST NAME ("A") AND LAST NAME ("B")
                'For Each HorseNumber in range(SheetTarget("D2:D70"))
                    EntryVerified = False
                    'If HorseNumber = Registration.cell("E" & Row()) And
                    'HorseNumber("A" & Row()) = cell("A" & Row()) And
                    'HorseNumber("B" & Row()) = cell("B" & Row()) Then
                    EntryVerified = True
                    Exit For
                    End If
                
                    If EntryVerified = False Then
                    cell.Offset("A" & Row()).Copy (SheetTarget("A" & LastRow)) 'rider's first name
                    cell.Offset("B" & Row()).Copy (SheetTarget.Range("B" & LastRow)) 'rider's last name
                    cell.Offset("C" & Row()).Copy (SheetTarget.Range("C" & LastRow)) 'horse name
                    cell.Offset("E" & Row()).Copy (SheetTarget.Range("D" & LastRow)) 'horse ID number
                    End If
                Next HorseNumber
            End If
        Next cell

End If
End Sub

Sheet name: "Registration" (The sub will reside in this sheet module)
*note: Cells A1, B1, C1, D1, and E1 are the only cells in the whole sheet that aren't dynamic. All other cell values change daily.
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[TD]K[/TD]
[TD]L[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]FIRST NAME[/TD]
[TD]LAST NAME[/TD]
[TD]HORSE NAME[/TD]
[TD]......[/TD]
[TD]HORSE TAG #[/TD]
[TD]POLES[/TD]
[TD]BARRELS[/TD]
[TD]FIGURE 8[/TD]
[TD]SPEAR RINGS[/TD]
[TD]BALL AND CHAIN[/TD]
[TD]KEYHOLE[/TD]
[TD]ZIG ZAG[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]SUSIE[/TD]
[TD]SMITH[/TD]
[TD]VIPER[/TD]
[TD][/TD]
[TD]55[/TD]
[TD]Adult[/TD]
[TD]Adult[/TD]
[TD][/TD]
[TD][/TD]
[TD]Adult[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]SALLY[/TD]
[TD]SMITH[/TD]
[TD]SABER[/TD]
[TD][/TD]
[TD]41[/TD]
[TD]Adult[/TD]
[TD]Adult[/TD]
[TD]Adult[/TD]
[TD]Adult[/TD]
[TD][/TD]
[TD][/TD]
[TD]Adult[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]KAREN[/TD]
[TD]MILLER[/TD]
[TD]KARMA[/TD]
[TD][/TD]
[TD]29[/TD]
[TD]Youth[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Youth[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]BILL[/TD]
[TD]BARKER[/TD]
[TD]ACE[/TD]
[TD][/TD]
[TD]22[/TD]
[TD]Jack Benny[/TD]
[TD]Jack Benny[/TD]
[TD]Jack Benny[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]KAREN[/TD]
[TD]MILLER[/TD]
[TD]ACE[/TD]
[TD][/TD]
[TD]22[/TD]
[TD]Youth[/TD]
[TD]Youth[/TD]
[TD][/TD]
[TD]Youth[/TD]
[TD]Youth[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]....[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]70[/TD]
[TD]JOE[/TD]
[TD]JOHNSON[/TD]
[TD]JACKO[/TD]
[TD][/TD]
[TD]88[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Jack Benny[/TD]
[/TR]
</tbody>[/TABLE]

The purpose of the sub() is to check the event sheets for the existence of a proper rider and horse entry... kind of self explanatory, but I'm showing the sheets after the sub runs for clarity...

Sheet name: "Adult POLES" (one of 21 possible division & event sheet names)
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]FIRST NAME[/TD]
[TD]LAST NAME[/TD]
[TD]HORSE NAME[/TD]
[TD]HORSE TAG #[/TD]
[TD]...[/TD]
[TD]...[/TD]
[TD]...[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]SUSIE[/TD]
[TD]SMITH[/TD]
[TD]VIPER[/TD]
[TD]55[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]SALLY[/TD]
[TD]SMITH[/TD]
[TD]SABER[/TD]
[TD]41[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]...[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]70[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
Sheet name: "Youth BALL AND CHAIN" (Another of 21 possible division & event sheet names)
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]FIRST NAME[/TD]
[TD]LAST NAME[/TD]
[TD]HORSE NAME[/TD]
[TD]HORSE TAG #[/TD]
[TD]...[/TD]
[TD]...[/TD]
[TD]...[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]KAREN[/TD]
[TD]MILLER[/TD]
[TD]KARMA[/TD]
[TD]29[/TD]
[TD]...[/TD]
[TD]...[/TD]
[TD]...[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]KAREN[/TD]
[TD]MILLER[/TD]
[TD]ACE[/TD]
[TD]22[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]...[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]70[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Many thanks to those who took the time to read, and bigger thanks to anyone who can help get me on track !
 
Sort by date Sort by votes

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
I added the good old message box for diagnostic purposes.. and get no messages... which i think means it's not detecting the onchange event in A2:L70.
Code: 
        For Each cell In Registration.Range("F2:L70") 'test each cell for exisitng matches on SheetTarget
            SheetTarget = ""
            If IsEmpty(cell) = False Then 'rider has entered that event, cell value indicates division
                SheetTarget = cell.Value & " " & cell(1, cell.Column)
                MsgBox (SheetTarget)
 
Upvote 0
Wow Mick, you came up with a fast and useful suggestion! (and i thank you!) I'm going to look at the elements of your creation for adaptation. One small problem I see so far is, the values of F1, G1, H1, I1, J1, K1, L1 are dynamically filled by a script in my sheet "MeetSetupSettings", where sheets are either created or deleted by change events in that sheet's A5:D11.
Thus, as an administrator makes changes to what today's events or divisions for such events are, the sheets will create or delete automatically.



Code: 
Private Sub Worksheet_Change(ByVal target As Range)
On Error Resume Next
'this works
If Not Intersect(target, Range("A5:D11")) Is Nothing Then
Dim NotFound As Boolean
Dim EventDivision As String
Dim EventName As String
Dim NewSheetName As String
Dim ExistingSheetNameChecker As String
Dim cell As Range
Dim division As Range
Dim MaxRow As Long
Dim wksInput As Worksheet
Dim Template As Worksheet
Dim Summary As Worksheet
Dim Reg As Worksheet
Dim wks As Worksheet
Const InputName = "MeetSetupSettings"
Const TemplateName = "TET"
Const SummaryName = "Meet_Results_Summary"
Const RegName = "Registration"

    
        Set wksInput = Worksheets(InputName)
            'set event divisions to empty if no event selected for that row
            For Each cell In wksInput.Range("A5:A11")
                If cell.Value = "" And cell.Offset(0, 1).Value <> "" Then
                    cell.Offset(0, 1).Value = ""
                End If
                If cell.Value = "" And cell.Offset(0, 2).Value <> "" Then
                    cell.Offset(0, 2).Value = ""
                End If
                If cell.Value = "" And cell.Offset(0, 3).Value <> "" Then
                    cell.Offset(0, 3).Value = ""
                End If
            Next cell
            
            'check for value in each column (B, C, and D), set new sheet name to create if not empty.
            For Each cell In wksInput.Range("A5:A11")
            
                'examine column B (youth division) for this row
                If IsEmpty(cell) = "False" And IsEmpty(cell.Offset(0, 1)) = "False" Then
                        NewSheetName = cell.Offset(0, 1).Value & " " & cell.Value:
                        'check for existing sheet
                        For Each wks In Worksheets
                            NotFound = True
                            If wks.Name Like NewSheetName Then
                            NotFound = False
                            Exit For
                            End If
                        Next wks
                            'else add the sheet and rename it as concatenated name
                            If NotFound = True Then
                                Worksheets(TemplateName).Copy After:=Worksheets(Worksheets.Count)
                                ActiveSheet.Name = NewSheetName
                                ActiveSheet.Range("B1") = "Cambridge Saddle Club - Event: " & NewSheetName
                                'go back to the MeetSetup sheet
                                Worksheets(InputName).Activate
                            End If
                End If
                
                'examine column C (adult division) for this row
                If IsEmpty(cell) = "False" And IsEmpty(cell.Offset(0, 2)) = "False" Then
                        NewSheetName = cell.Offset(0, 2).Value & " " & cell.Value:
                        'check for existing sheet
                        For Each wks In Worksheets
                            NotFound = True
                            If wks.Name Like NewSheetName Then
                            NotFound = False
                            Exit For
                            End If
                        Next wks
                            'else add the sheet and rename it as concatenated name
                            If NotFound = True Then
                                Worksheets(TemplateName).Copy After:=Worksheets(Worksheets.Count)
                                ActiveSheet.Name = NewSheetName
                                ActiveSheet.Range("B1") = "Cambridge Saddle Club - Event: " & NewSheetName
                                'Go back to the MeetSetup sheet
                                Worksheets(InputName).Activate
                            End If
                End If
                
                'examine column D (jack benny division)for this row
                If IsEmpty(cell) = "False" And IsEmpty(cell.Offset(0, 3)) = "False" Then
                        NewSheetName = cell.Offset(0, 3).Value & " " & cell.Value:
                        'check for existing sheet
                        For Each wks In Worksheets
                            NotFound = True
                            If wks.Name Like NewSheetName Then
                            NotFound = False
                            Exit For
                            End If
                        Next wks
                            'else add the sheet and rename it as concatenated name
                            If NotFound = True Then
                                Worksheets(TemplateName).Copy After:=Worksheets(Worksheets.Count)
                                ActiveSheet.Name = NewSheetName
                                ActiveSheet.Range("B1") = "Cambridge Saddle Club - Event: " & NewSheetName
                                'Go back to the MeetSetup sheet
                                Worksheets(InputName).Activate
                            End If
                End If
                
            Next cell
            
'NOW CHECK THE SHEETS THAT EXIST FOR ONES THAT DON'T MATCH THE CURRENT EVENT AGENDA

    'Delete worksheets that don't match the event Names BUT IGNORE sheets named MeetSetupSettings, Template, Summary or Registration
    'This might seem confusing as the sheet names are a concatenated name; column A & another column in that row.
    'example: "youth" (column B) & "barrel race" (column A)
    For Each wks In Worksheets
        NotFound = True
        ExistingSheetNameChecker = " "
        'Keep Input and Template worksheets safe
        If Not (wks.Name Like InputName Or wks.Name Like TemplateName Or wks.Name Like SummaryName Or wks.Name Like RegName) Then
            'Check all current event names in youth division (column B) for matches
            For Each cell In wksInput.Range("A5:A11")
                ExistingSheetNameChecker = cell.Offset(0, 1).Value & " " & cell.Value
                If wks.Name Like ExistingSheetNameChecker And IsEmpty(cell.Offset(0, 1)) = "False" Then
                    NotFound = False
                    Exit For
                End If
            Next cell
            'Check all current event names in adult division (column C) for matches
            For Each cell In wksInput.Range("A5:A11")
                ExistingSheetNameChecker = cell.Offset(0, 2).Value & " " & cell.Value
                If wks.Name Like ExistingSheetNameChecker And IsEmpty(cell.Offset(0, 2)) = "False" Then
                    NotFound = False
                    Exit For
                End If
            Next cell
            'Check all current event names in jack benny division (column D) for matches
            For Each cell In wksInput.Range("A5:A11")
                ExistingSheetNameChecker = cell.Offset(0, 3).Value & " " & cell.Value
                If wks.Name Like ExistingSheetNameChecker And IsEmpty(cell.Offset(0, 3)) = "False" Then
                    NotFound = False
                    Exit For
                End If
            Next cell
        Else
            NotFound = False
        End If
        'Match was not found, delete worksheet
        If NotFound Then
            'Delete worksheet
            Application.DisplayAlerts = False
            wks.Delete
            Application.DisplayAlerts = True
        End If
    Next wks
            
' "end if" below is for the OnChange event
End If
End Sub

MickG said:
Try this Example:-
https://app.box.com/s/6q2ub2izavzxyspkfw0yad39g25r3drb
Click to expand...
 
Upvote 0
The other thing I've discovered is that your code has no regard for duplicates. When I enter an exact duplicate of the "A" to "D" values, it copies them not realizing it's already there.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question Question
Need help with VBA copy if condition is met and clear range error message
Replies
6
Views
803
Yongle
Yongle
K
  • Question Question
UserForm code not playing well with sheet code- OnChange
Replies
3
Views
1K
Kelly05201
K
M
  • Question Question
Need help converting offset formula for dynamic range in vba
2
Replies
14
Views
3K
michaelsmith559
M
K
  • Question Question
Simplify VBA Code (Loop through a column range and assign variables to cell address values)
Replies
2
Views
6K
kathendy
K

Forum statistics

Threads
1,223,236
Messages
6,170,912
Members
452,366
Latest member
TePunaBloke

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