Help with Arrays - VBA

E

esbjornsson

New Member
Joined
Feb 26, 2012
Messages
6
Hi!
I have a question regarding the array command in my VBA code. (Problem explained below the code.)

Ok, let me first explain my intention with my sheet and code...

I'm a teacher and need to document if my pupils have submitted their homework or not every week. Therefor I have built a sheet for that. In this sheet I have a droplist (data verification list). The droplist contains different school subjects. If I choose i.e. math in the droplist a hidden column named Ma will be shown. I have done this with the array command, see this code:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Changed As Range, Found As Range
    Dim i As Long
    
    mySubjCols = Array("R4", "AH", "AX", "BN", "CD", "CT", "DJ", "DZ", "EP", "FF", "FV", "GL", "HB", "HR", "IH", "IX", "JN", "KD", "KT", "LI")
    mySvCols = Array("C", "S", "AI", "AY", "BO", "CE", "CU", "DK", "EA", "EQ", "FG", "FW", "GM", "HC", "HS", "II", "IY", "JO", "KE", "KU")
    myEngCols = Array("D", "T", "AJ", "AZ", "BP", "CF", "CV", "DL", "EB", "ER", "FH", "FX", "GN", "HD", "HT", "IJ", "IZ", "JP", "KF", "KV")
    myMaCols = Array("E", "U", "AK", "BA", "BQ", "CG", "CW", "DM", "EC", "ES", "FI", "FZ", "GO", "HE", "HU", "IK", "JA", "JQ", "KG", "KW")
    myShCols = Array("F", "V", "AL", "BB", "BR", "CH", "CX", "DN", "ED", "ET", "FJ", "GA", "GP", "HF", "HV", "IL", "JB", "JR", "KH", "KX")
    myRelCols = Array("G", "W", "AM", "BC", "BS", "CI", "CY", "DO", "EE", "EU", "FK", "GB", "GQ", "HG", "HW", "IM", "JC", "JS", "KI", "KY")
    myGeCols = Array("H", "X", "AN", "BD", "BT", "CJ", "CZ", "DP", "EF", "EV", "FL", "GC", "GR", "HH", "HX", "IN", "JD", "JT", "KJ", "KZ")
    myHiCols = Array("I", "Y", "AO", "BE", "BU", "CK", "DA", "DQ", "EG", "EW", "FM", "GD", "GS", "HI", "HY", "IO", "JE", "JU", "KK", "LA")
    myTeCols = Array("J", "Z", "AP", "BF", "BV", "CL", "DB", "DR", "EH", "EX", "FN", "GE", "GT", "HJ", "HZ", "IP", "JF", "JV", "KL", "LB")
    myKeCols = Array("K", "AA", "AQ", "BG", "BW", "CM", "DC", "DS", "EI", "EY", "FO", "GF", "GU", "HK", "IA", "IQ", "JG", "JW", "KM", "LC")
    myFyCols = Array("L", "AB", "AR", "BH", "BX", "CN", "DD", "DT", "EJ", "EZ", "FP", "GG", "GV", "HL", "IB", "IR", "JH", "JX", "KN", "LD")
    myBiCols = Array("M", "AC", "AS", "BI", "BY", "CO", "DE", "DU", "EK", "FA", "FQ", "GH", "GW", "HM", "IC", "IS", "JI", "JY", "KO", "LE")
    myBildCols = Array("N", "AD", "AT", "BJ", "CZ", "CP", "DF", "DV", "EL", "FB", "FR", "GI", "GX", "HN", "ID", "IT", "JJ", "JZ", "KP", "LF")
    myIdCols = Array("O", "AE", "AU", "BK", "CA", "CQ", "DG", "DW", "EM", "FC", "FS", "GJ", "GY", "HO", "IE", "IU", "JK", "KA", "KQ", "LG")
    myMuCols = Array("P", "AF", "AV", "BL", "CB", "CR", "DH", "DX", "EN", "FD", "FT", "GK", "GZ", "HP", "IF", "IV", "JL", "KB", "KR", "LH")

    Application.ScreenUpdating = False

    For i = 0 To UBound(mySvCols)
    Set Changed = Intersect(Target, Columns(mySubjCols(i)))
        If Not Changed Is Nothing Then
            Set Found = Changed.Find(What:="Sv")
            If Found Is Nothing Then
                Columns(mySvCols(i)).Hidden = True
            Else
                Columns(mySvCols(i)).Hidden = False
            End If
        End If
    Next i
    
    For i = 0 To UBound(myMaCols)
    Set Changed = Intersect(Target, Columns(mySubjCols(i)))
        If Not Changed Is Nothing Then
            Set Found = Changed.Find(What:="Ma")
            If Found Is Nothing Then
                Columns(myMaCols(i)).Hidden = True
            Else
                Columns(myMaCols(i)).Hidden = False
            End If
        End If
    Next i
    
        For i = 0 To UBound(myEngCols)
    Set Changed = Intersect(Target, Columns(mySubjCols(i)))
        If Not Changed Is Nothing Then
            Set Found = Changed.Find(What:="Eng")
            If Found Is Nothing Then
                Columns(myEngCols(i)).Hidden = True
            Else
                Columns(myEngCols(i)).Hidden = False
            End If
        End If
    Next i
   
           For i = 0 To UBound(myShCols)
    Set Changed = Intersect(Target, Columns(mySubjCols(i)))
        If Not Changed Is Nothing Then
            Set Found = Changed.Find(What:="Sh")
            If Found Is Nothing Then
                Columns(myShCols(i)).Hidden = True
            Else
                Columns(myShCols(i)).Hidden = False
            End If
        End If
    
    Next i
    
               For i = 0 To UBound(myRelCols)
    Set Changed = Intersect(Target, Columns(mySubjCols(i)))
        If Not Changed Is Nothing Then
            Set Found = Changed.Find(What:="Rel")
            If Found Is Nothing Then
                Columns(myRelCols(i)).Hidden = True
            Else
                Columns(myRelCols(i)).Hidden = False
            End If
        End If
    
    Next i
    
               For i = 0 To UBound(myGeCols)
    Set Changed = Intersect(Target, Columns(mySubjCols(i)))
        If Not Changed Is Nothing Then
            Set Found = Changed.Find(What:="Geo")
            If Found Is Nothing Then
                Columns(myGeCols(i)).Hidden = True
            Else
                Columns(myGeCols(i)).Hidden = False
            End If
        End If
    
    Next i
    
               For i = 0 To UBound(myHiCols)
    Set Changed = Intersect(Target, Columns(mySubjCols(i)))
        If Not Changed Is Nothing Then
            Set Found = Changed.Find(What:="Hi")
            If Found Is Nothing Then
                Columns(myHiCols(i)).Hidden = True
            Else
                Columns(myHiCols(i)).Hidden = False
            End If
        End If
    
    Next i
    
               For i = 0 To UBound(myTeCols)
    Set Changed = Intersect(Target, Columns(mySubjCols(i)))
        If Not Changed Is Nothing Then
            Set Found = Changed.Find(What:="Te")
            If Found Is Nothing Then
                Columns(myTeCols(i)).Hidden = True
            Else
                Columns(myTeCols(i)).Hidden = False
            End If
        End If
    
    Next i
    
               For i = 0 To UBound(myKeCols)
    Set Changed = Intersect(Target, Columns(mySubjCols(i)))
        If Not Changed Is Nothing Then
            Set Found = Changed.Find(What:="Ke")
            If Found Is Nothing Then
                Columns(myKeCols(i)).Hidden = True
            Else
                Columns(myKeCols(i)).Hidden = False
            End If
        End If
    
    Next i
    
               For i = 0 To UBound(myFyCols)
    Set Changed = Intersect(Target, Columns(mySubjCols(i)))
        If Not Changed Is Nothing Then
            Set Found = Changed.Find(What:="Fy")
            If Found Is Nothing Then
                Columns(myFyCols(i)).Hidden = True
            Else
                Columns(myFyCols(i)).Hidden = False
            End If
        End If
    
    Next i
    
               For i = 0 To UBound(myBiCols)
    Set Changed = Intersect(Target, Columns(mySubjCols(i)))
        If Not Changed Is Nothing Then
            Set Found = Changed.Find(What:="Bi")
            If Found Is Nothing Then
                Columns(myBiCols(i)).Hidden = True
            Else
                Columns(myBiCols(i)).Hidden = False
            End If
        End If
    
    Next i
    
               For i = 0 To UBound(myBildCols)
    Set Changed = Intersect(Target, Columns(mySubjCols(i)))
        If Not Changed Is Nothing Then
            Set Found = Changed.Find(What:="Bild")
            If Found Is Nothing Then
                Columns(myBildCols(i)).Hidden = True
            Else
                Columns(myBildCols(i)).Hidden = False
            End If
        End If
    
    Next i
    
               For i = 0 To UBound(myIdCols)
    Set Changed = Intersect(Target, Columns(mySubjCols(i)))
        If Not Changed Is Nothing Then
            Set Found = Changed.Find(What:="Id")
            If Found Is Nothing Then
                Columns(myIdCols(i)).Hidden = True
            Else
                Columns(myIdCols(i)).Hidden = False
            End If
        End If
    
    Next i
    
                   For i = 0 To UBound(myMuCols)
    Set Changed = Intersect(Target, Columns(mySubjCols(i)))
        If Not Changed Is Nothing Then
            Set Found = Changed.Find(What:="Mu")
            If Found Is Nothing Then
                Columns(myMuCols(i)).Hidden = True
            Else
                Columns(myMuCols(i)).Hidden = False
            End If
        End If
    
    Next i
    
    Application.ScreenUpdating = True
    
End Sub

My problem:
Below my droplist I thought I could write the score each pupil gets on a weekly test BUT when I do that my subject columns disappear... Does anyone know how to fix this?

Link to the file (Look at sheet "Läxor"):
http://dl.dropbox.com/u/4400615/Sammanställning elever.xlsm

Thanks in advance! =)

/ Kristofer
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Sort by date Sort by votes
Put these two lines in your code just below the Dim statements

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Changed As Range, Found As Range
    Dim i As Long
    [color=red]
    If Target.Count > 1 Then Exit Sub
    If Intersect(Range("R4:IH4"), Target) Is Nothing Then Exit Sub[/color]

The .Count line exits the procedure if you change more that one cell e.g. delete a row or clear a range of cells.

The Intersect line exits the procedure if you made a change in any cell other than cells R4:IH4 (your drop down lists).
 
Upvote 0
You must log in or register to reply here.

Similar threads

Agnarr
  • Solved
Checkbox Timestamp with VBA
Replies
3
Views
217
bobsan42
bobsan42
A
  • Question
After User Enters A Value (Validation List), Not Automatically Advancing To Next Cell As Per "Select"
Replies
1
Views
176
Ark68
A
K0st4din
  • Solved
Macro hide inconsistent selected columns in selected worksheets
Replies
6
Views
138
Alex Blakenburg
A
B
  • Solved
Another VBA question to hide/unhide rows based on cell value in another sheet
2
Replies
12
Views
430
kevin9999
K
B
  • Locked
  • Question
Multiply VBA Macro for hiding and unhiding rows
Replies
4
Views
378
RoryA
RoryA

Forum statistics

Threads
1,214,924
Messages
6,122,294
Members
449,077
Latest member
Rkmenon

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