Help needed with making a faster, more efficient VBA code

[TAPS_MikeDion]

Hello everybody,
This code does work, but I'm betting it can be shortened to be faster and more efficient since I'm not that well versed in VBA coding. Would anyone be willing to help me with that?

I greatly appreciate any help given. If the spreadsheets will be needed to "recreate" the code, I'll have to post them with bugus data tomorrow.

Thank you!

With Sheets("Division Member Info")
    .Range("AJ3:AO500").ClearContents
    For Each c In .Range("D3", .Range("D" & Rows.Count).End(3))
      For Each sh In Sheets
        If UCase(Left(sh.Name, 2)) = "D-" Then
          IDr = sh.Cells(Rows.Count, 7).End(xlUp).Row
          'Get last row with an ID number
          If IDr > 1 Then
            'There is at least 1 ID number
            For n = 2 To IDr
              'Loop through ID numbers
              If c = sh.Range("G" & n) Then
                'Matching ID number found
                Dn = sh.Range("A" & n).Value
                'Dn is assigned the value of the Detail / Event # in column A of the DMI sheet
                Select Case Dn
                'Place an X in the appropriate Detail / Event # row for the matching ID in the DMI sheet
                  Case 1
                    'Road Race
                    .Range("AJ" & c.Row).Value = "X"
                  Case 2
                    'Parade
                    .Range("AK" & c.Row).Value = "X"
                  Case 3
                    'Fireworks
                    .Range("AL" & c.Row).Value = "X"
                  Case 4
                    'Fiestas Patronales
                    .Range("AM" & c.Row).Value = "X"
                  Case 5
                    'Celebrate Holyoke
                    .Range("AN" & c.Row).Value = "X"
                  Case 6
                    'Tree Lighting
                    .Range("AO" & c.Row).Value = "X"""
                End Select
              End If
            Next
          End If
        End If
      Next
    Next
  End With

 

[TAPS_MikeDion]

I had a feeling. Below is the link to the Dropbox file. Hopefully it works.

I removed all unnecessary tabs and macros, along with throwing in bogus data for you to use.

Thanks again!

MrExcel - Example

 

[jkpieterse]

What about replacing the entire Select Case Dn block with just:

    .Range("AI" & c.Row).Offset(0, Dn).Value = "X"

 

[JEC]

I see a made a typo in that specific line

ar2 = sh.Range("A", sh.Range("A" & Rows.Count).End(xlUp)).Resize(, 7)

should be

ar2 = sh.Range("A1", sh.Range("A" & Rows.Count).End(xlUp)).Resize(, 7)

I also noticed that you have empty values in your "Detail/Event#" column, assuming you don't have these empty lines in your real file (when there is a match).

Sub jec()
 Dim ar, ar2, sh, j As Long, jj As Long
 With Sheets("Division Member Info")
   .Range("AJ3:AO500").ClearContents
    ar = .Range("D3", .Range("D" & Rows.Count).End(3)).Resize(, 38)
    For j = 1 To UBound(ar)
      For Each sh In Sheets
        If UCase(Left(sh.Name, 2)) = "D-" Then
          ar2 = sh.Range("A1", sh.Range("A" & Rows.Count).End(xlUp)).Resize(, 7)
          If UBound(ar2) > 1 Then
            For jj = 2 To UBound(ar2)
              If ar(j, 1) = ar2(jj, 7) Then
                ar(j, 32 + ar2(jj, 1)) = "X"
                Exit For
              End If
            Next
          End If
        End If
      Next
    Next
  .Range("D3", .Range("D" & Rows.Count).End(3)).Resize(, 38) = ar
 End With
End Sub

 

[TAPS_MikeDion]

Hello jk,
Thank you for your response. Again I'm not that well-versed in VBA coding, but are you sure about trying:

 .Range("AI" & c.Row).Offset(0, Dn).Value = "X"

Only reason I'm asking is because you have column "AI" and that column in my sheet has nothing to do with the code I'm trying to make more efficient.

Hello JEC,
Before I try the code you provided (thank you for that!), the empty values in the "Detail/Event#" column ARE in the actual sheet. It's only those 6 details in my list that are needed for this code. Thank you.

 

[jkpieterse]

It's AI, because in the original you are looking at AJ, AK, AL, ... and I use the Offset function to get to those columns, using the value of the variable called Dn.
I could have used AJ though:

.Range("AJ" & c.Row).Offset(0, Dn - 1).Value = "X"

 

[TAPS_MikeDion]

Ahhh....gotcha. Thank you!

 

[TAPS_MikeDion]

Hi jkp,
As info, I tried both versions of your code in the backup of my actual sheet, and both versions put X's in starting at the column prior (AI), in some rows put X's in for all 6 details (detail #'s currently only go up to 4 in my actual sheet), and then froze Excel. I had to revert back to my original Excel file. Thank you for trying anyway.

 

[TAPS_MikeDion]

Hello JEC,
Will your code still work okay even though the empty values in the "Detail/Event#" column ARE in the actual sheet?

Thank you.

 

[JEC]

Probably not. The column where to put the “X” is based on that detail/event column

 

[TAPS_MikeDion]

Oh, okay. Thank you anyway.