VBA - Indexing, Matching, I don't remember

concreteinterface

Board Regular
Joined
Jul 10, 2008
Messages
144
Hi! It's been a while since I've been to the board. Happy to see you all here.

I've hadn't had to build many VBA programs lately and if I do, I've built up a pretty good library of VBA examples to help get me through.

I am working on a pet project using data from a golf launch monitor to map out golf shot dispersion.

The data exported gives many different values, but the values I am working with are total yardage of the shot and how many yards the shot was left (negative value) or right (positive value).

I've created a macro to form a grid with a 10% adder to all yardages to give the mapping some room.

In the top row, starting in the B2, I list the yardages (left to right). -60, -59, -58, ......... , 58, 59, 60. Then I list the total yardage in the A column starting in A2. 230, 229, 228, ..... 3, 2, 1, 0.

I've been able to use a Find function to look in the 1:1 row and find 0, then the A:A column to find 0. Then I get the address of both and make the resulting cell address a green color signifying the tee.

I tried to then apply this logic to place my shots, so find -10 in A:A and 210 in 1:1 and make that a red cell. The problem is that no matter what I tried, the Find function wasn't working all of the time. It worked for some, but not others. It was the first time I've seen an intermittent problem with a function. I tried to fix it for an hour.

Then I remembered something about using Index and Match to find crosspoints of data, but I don't remember how it's done or even what to call it so I can Google it.

Does anyone have any tips?
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Here's what I was working with. It's been a minute since I looked at it and may have some errors because I was trying everything.

VBA Code:
Sub SetupDispersion()
'
' Macro1 Macro
'

'Format the grid
    Sheets("Dis").Select
    Dist = Sheets("Temp").Range("U4").Value
    DispW = Sheets("Temp").Range("U6").Value
    DispL = Sheets("Temp").Range("U3").Value
    DispR = Sheets("Temp").Range("U2").Value

    
    Cells.Select
    Selection.Delete Shift:=xlUp
    
    Range(Cells(1, 1), Cells(Dist, DispW + 1)).Select
    Selection.ColumnWidth = 1.92
    Selection.RowHeight = 14.6

    ActiveWindow.Zoom = True
    Range("B1").Select

'Enter the yeardage markers
    For i = 2 To DispW + 1
        Cells(1, i).Value = DispL
        DispL = DispL + 1
        Next
    
    
    For i = 2 To Dist + 2
        Cells(i, 1).Value = Dist
        Dist = Dist - 1
    Next

    Columns("A:A").Select
    Selection.NumberFormat = "0"
    Rows("1:1").Select
    Selection.NumberFormat = "0"
    
    
'Find and mark the tee point
    Dim FindString As Integer
    Dim Rng As Range
    FindString = 0
    If Trim(FindString) <> "" Then
        With Sheets("Dis").Range("A:A")
            Set Rng = Sheets("Dis").Range("A:A").Find(What:=FindString, _
                            After:=Sheets("Dis").Range("A:A").Cells(Sheets("Dis").Range("A:A").Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
    
    Dist0 = ActiveCell.Row
    
    FindString = 0
    If Trim(FindString) <> "" Then
        With Sheets("Dis").Range("1:1")
            Set Rng = Sheets("Dis").Range("1:1").Find(What:=FindString, _
                            After:=Sheets("Dis").Range("1:1").Cells(Sheets("Dis").Range("1:1").Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
    
    Disp0 = ActiveCell.Column
    
    Cells(Dist0, Disp0).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    Range("A1").Select
    

'Yardage markers

    Dist = Sheets("Temp").Range("U4").Value
    
    

End Sub


Sub ShotMarkers()
    Dim TotalDist As String
    Dim Offline As String
    Dim Rng As Range
    
    n = Worksheets("Temp").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
    For i = 2 To n
        TotalDist = Sheets("Temp").Range("I" & i).Value
        Offline = Sheets("Temp").Range("H" & i).Value

            FindString = TotalDist
            If Trim(FindString) <> "" Then
                    Set Rng = Range("A:A").Find(What:=FindString, _
                                    After:=Range("A:A").Cells(Range("A:A").Cells.Count), _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=False)
                    If Not Rng Is Nothing Then
                        Application.Goto Rng, True
                    Else
                        'MsgBox "Nothing found"
                    End If
            End If
            
            TotalDist = ActiveCell.Row
            
            
            FindString = Offline
            If Trim(FindString) <> "" Then
                    Set Rng = Range("1:1").Find(What:=FindString, _
                                    After:=Range("1:1").Cells(Range("1:1").Cells.Count), _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=False)
                    If Not Rng Is Nothing Then
                        Application.Goto Rng, True
                    Else
                        'MsgBox "Nothing found"
                    End If
            End If
        
            Offline = ActiveCell.Column
            
            Cells(Offline, TotalDist).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 5287936
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        
    Next

End Sub
 
Upvote 0

Forum statistics

Threads
1,213,513
Messages
6,114,072
Members
448,546
Latest member
KH Consulting

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