Macro to search row and column for intersect and then input a data to where they meet

Hi Everyone,

Here is a problem way beyond my comprehension. Help is needed!!

In my "cover" sheet I click the allocate cover button and it then generates a list of data below the first table. This generated data now needs to update the "timetable" sheet by using the "allocated cover teacher" and "period" cells as a reference to then input the class code into the timetable at this time.

cover.jpg

So in this picture we see that Dorothy*Schultz (in cell E27) has been given a class 3 MABA RM 15(cell D27) on TuesdayP1 (C27). I want search for Dorothy*Schultz and TuesdayP1 in the "timetable" tab to input the name of the class which in this instance would be input to cell I20 in the "timetable tab".

I imagine I will need to explain this further but if anyone feels they can make any sense of my request please get in touch.
VBA COVER Forum Version 1.xls
Thanks
Alasdair

Hi Alasdair,

I'll take a more in depth look at this tomorrow - have you defined exactly what it is that you want from us??

Hi Alasdair,

I'm having trouble with my forum configuration - but try this:

Sub ClearForm(): Dim wc As Worksheet, wt As Worksheet
Dim ACT As String, Per As String, Cls As String
Dim i As Long, j As Long, r As Long, c As Long
Set wc = Worksheets("Cover"): Set wt = Worksheets("Timetable")
                
        
        For i = 27 To 39 Step 2
ACT = wc.Range("E" & i): Per = wc.Range("C" & i): Cls = wc.Range("D" & i)
                If ACT = "0" Then GoTo GetNext
    If InStr(1, ACT, "(") Then ACT = Left(ACT, Len(ACT) - 5)
            r = wt.Range("A:A").Find(ACT).Row:
    c = 1: Do Until Cells(1, c) = Per: c = c + 1: Loop
                wt.Cells(r, c) = Cls: wt.Cells(r, c).Font.ColorIndex = 3
GetNext:        Next i
        
                With wc
        .Range("A11:F24").Copy
        .Rows(26).Insert Shift:=xlDown
        .Rows("26:39").RowHeight = 42
        .Range("A26:F39").Copy: .Range("F26").PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                End With
     
    Union(wc.Range("B7:H7"), wc.Range("A3:C3")).ClearContents
End Sub

Hi Alasdair,

You have to run it on the sheet before you wipe out the entries in the field. The first run will work, the second can't because of the wipeouts

We could remove the wipeout code but the macro name is ClearForm after all!

Well, if there is no data in the cover sheet;;what do you do??

Hi Alasdair,

Try this:

Sub ClearForm(): Dim wc As Worksheet, wt As Worksheet
Dim ACT As String, Per As String, Cls As String
Dim i As Long, j As Long, r As Long, c As Long
Set wc = Worksheets("Cover"): Set wt = Worksheets("Timetable")
                
        
        For i = 27 To 39 Step 2
        ACT = wc.Range("E" & i): Per = wc.Range("C" & i)
        If IsError(wc.Range("D" & i)) Then Exit Sub
                Cls = wc.Range("D" & i)
                
                If ACT = "0" Then GoTo GetNext
    If InStr(1, ACT, "(") Then ACT = Left(ACT, InStr(1, ACT, "(") - 2)
            r = wt.Range("A:A").Find(ACT).Row:
    c = 1: Do Until wt.Cells(1, c) = Per: c = c + 1: Loop
                wt.Cells(r, c) = Cls: wt.Cells(r, c).Font.ColorIndex = 3
GetNext:        Next i
        
                With wc
        .Range("A11:F24").Copy
        .Rows(26).Insert Shift:=xlDown
        .Rows("26:39").RowHeight = 42
        .Range("A26:F39").Copy: .Range("F26").PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                End With
     
    Union(wc.Range("B7:H7"), wc.Range("A3:C3")).ClearContents
End Sub