Looping through sheets and retrieving data from specific cells

[Alemap]

Good Day everyone, I'm trying to loop through many sheets in a workbook and retrieve data from a table array of size A54:AD73 on a particular date and post the values into a table array in a results sheet. (see table below)
The values to be collected against a Name, which is in cell C1 of every sheet, will be in columns Y to AD in the row with the date, which could be in different rows for each sheet. The date if it has been entered, resides in Column B of every sheet.

I Have being trying to combine code that I already have that loops through all sheets and retrieves summary data from the same cells of each sheet.

The code below runs but it only retrieves data from row B54 in which I entered the date for each sheet for testing but am unable to proceed with looping throgh the sheets, match the date and post the data in the results sheet

[VBA Code]
Sub MonthlyMedal()


ActiveSheet.Unprotect Password:="xxxx"
Dim i As Long
Dim j As Long
Dim MatchDay As Date
Dim Lastrow As Long

Dim wksMonthlyMedal As Worksheet
Dim wksCurr As Worksheet
Dim arrData() As Variant
Dim intRow As Integer
'MatchDay = InputBox("Match Date Is")
MatchDay = "19/01/19"


intRow = 0
ReDim arrData(1 To ThisWorkbook.Worksheets.Count - 1, 1 To 7)

Set wksResults = ThisWorkbook.Worksheets("Results")
Set wksLady_Players = ThisWorkbook.Worksheets("Lady_Players")
Set wksSurvey = ThisWorkbook.Worksheets("Survey")
Set wksTemplate = ThisWorkbook.Worksheets("Template")
Set wksMonthlyMedal = ThisWorkbook.Worksheets("MonthlyMedal")

Dim screenUpdateState
Dim calcState
Dim eventsState

'check functionality status

screenUpdateState = Application.ScreenUpdating
calcState = Application.Calculation
eventsState = Application.EnableEvents

'turn off screen updating to stop flicker & increase speed
'turn off automatic recalculating mode
'turn off events processing

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False



For Each wksCurr In ThisWorkbook.Worksheets

If wksCurr.Name <> wksResults.Name _
And wksCurr.Name <> wksLady_Players.Name _
And wksCurr.Name <> wksSurvey.Name _
And wksCurr.Name <> wksMonthlyMedal.Name _
And wksCurr.Name <> wksTemplate.Name Then


'For j = 54 To 56
' If wksCurr.Range(j, "B") = MatchDay Then
' MsgBox ActiveWorkbook.Worksheets(i).Cells(j, "B").Value
' MsgBox wksCurr.Range(j, "B").Value
' Next
'Lastrow = Lastrow + 1
'End If
'
intRow = intRow + 1
arrData(intRow, 1) = wksCurr.Range("C1") 'B Name
arrData(intRow, 2) = wksCurr.Range("Y54") 'C Score 1
arrData(intRow, 3) = wksCurr.Range("Z54") 'D Score 2
arrData(intRow, 4) = wksCurr.Range("AA54")'E Score 3
arrData(intRow, 5) = wksCurr.Range("AB54") 'F Score 4
arrData(intRow, 6) = wksCurr.Range("AC54") 'G Putts
arrData(intRow, 7) = wksCurr.Range("AD54") 'H Division
'

End If
Next wksCurr
wksMonthlyMedal.Range("B5").Resize(UBound(arrData), UBound(arrData, 2)) = arrData
Set wksCurr = Nothing
Set wksMonthlyMedal = Nothing

Application.ScreenUpdating = screenUpdateState
Application.Calculation = calcState
Application.EnableEvents = eventsState
ActiveSheet.Protect Password:="7410", DrawingObjects:=True, Contents:=True, Scenarios:=True


End Sub [/Code]

 

[Alemap]

Have you tried it with and without GWteB's second suggestion of adding .Value to the end of the line that copies Y:AD?

I have added .Value to the end of the line that copies Y:AD? Eureka !!! You guys have done it! I believe it works beautifully - Thank you so much! Happy New Year????

Now the table starts in Row six and needs to be moved up one to row 5 for completeness sake

Thank you both so much - I have to have this ready for the Ladies Golf by the 19th Jan.

I will also try your code GWEteB module probably tomorrow sometime - bit late here now.

 

[jasonb75]

Now the table starts in Row six and needs to be moved up one to row 5 for completeness sake

That's an easy one, there are 3 lines like .Range("B6").Offset(rCount). For each of those lines, the range dictates where the first entry is made, so changing "B6" to "B5", etc will move everything up 1 row.

 

[GWteB]

I have to have this ready for the Ladies Golf by the 19th Jan.

Somehowe I got such an impression ...

I will also try your code GWEteB module probably tomorrow sometime - bit late here now.

Exploring the VBA world can't do you any harm ... Succes! Please leave a message about your discoveries.
The following has to be noted:
- Both modules are dependent on each other;
- After importing those modules there could be some duplications (variables, subs, and so on) so it's possible that the VBA editor wants to start arguing. To tackle this obvious issue (we've been working on the same code) make use of a copy of your Excel file and remove the original code of the sub involved.

 

[Alemap]

Somehowe I got such an impression ...


Exploring the VBA world can't do you any harm ... Succes! Please leave a message about your discoveries.
The following has to be noted:
- Both modules are dependent on each other;
- After importing those modules there could be some duplications (variables, subs, and so on) so it's possible that the VBA editor wants to start arguing. To tackle this obvious issue (we've been working on the same code) make use of a copy of your Excel file and remove the original code of the sub involved.

I will certainly let you know how I get on GWteB. I can't thank you guys enough.

 

[GWteB]

You're welcome

 

[Alemap]

You're welcome

Hi GWteB, and JasonB75, I am tidying up the file after which I'll attempt save to it another name and replace the cosde with GWteB code using the forms. I have added a dropdown box for the user to select the date to run the code. It works well BUT I have encountered a bit of a problem because I cannot delete any table contents for testing and I wondered if it is the influence of the validation box and restrictions and how do I deal with it? Further any activity on the results table causes it to be protected.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
   Set KeyCells = Range("L5")
   Call MonthlyMedal
  
   End Sub


Private Sub MonthlyMedal()

With ActiveSheet
    .Unprotect Password:="xxxx" ' remove protection
         
Dim MatchDay As Date, calcState As Long, wksCurr As Worksheet, c As Range, rCount As Long
 MatchDay = Range("L5").Value     'Set date from dropdown box L5
'MatchDay = InputBox("Match Date Is") 'set date, anything that is not a valid date could cause an error
With Application
    calcState = .Calculation ' turn a few things off to speed things up a bit
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
End With
ETC

Your comments and advice would be much appreciated.

 

[GWteB]

I cannot assess the influence of the validation boxes remotely but sheet protection when not implemetend well can give people headaches. My advise in your situation: get rid of it!
Throughout the different posts in this thread there has been some disappearance. For what I can see now, probably the following is missing somewhere at the end of your sub:

ActiveSheet.Protect Password:="7410", DrawingObjects:=True, Contents:=True, Scenarios:=True

 

[Alemap]

Thank you GWteB, I will look into that.

 

[Alemap]

I cannot assess the influence of the validation boxes remotely but sheet protection when not implemetend well can give people headaches. My advise in your situation: get rid of it!
Throughout the different posts in this thread there has been some disappearance. For what I can see now, probably the following is missing somewhere at the end of your sub:

ActiveSheet.Protect Password:="7410", DrawingObjects:=True, Contents:=True, Scenarios:=True

I have gone through the code this end and I think it is because the Dropdown list invokes the main code which includes protecting the sheet each time it is run - if that makes sense?
Leading on from this, is that I am using dynamic sort code for the columns to sort them individually - its code I always use for sorting columns that may change length. The code is sheet based of course but all of a sudden there is an element of the execution that is different from all my other sheets that I have been using it in.
After execution the sorted column remains selected. This has never happened before, to my knowledge. Below are snips of sorted columns from two sheets in the same workbook that have used the same code. One shows the column selected and the other shows the result where the column is not selected once the sort code has executed whether the column is populated or blank.

Fig:1 Column 4 remains selected after sorting execution

Fig:2 Column 4 is de-selected after sorting execution

Dim DataFirstCell 'First cell of the data Range
Dim DataLastCell   'Last cell of the data Range
Dim SortRngStart  'First cell of the sort Range
Dim SortRngEnd    'Last cell of the sort Range
Dim screenUpdateState

'check functionality status

    screenUpdateState = Application.ScreenUpdating
    
    Application.ScreenUpdating = False 'turn off screen updating to stop flicker & increase speed

    ActiveSheet.Unprotect Password:="xxxx"

'******* Establish the Data Area
'
Range("B4").Select 'Get to the first cell of data area
DataFirstCell = ActiveCell.Address 'Get the first cell address of Data Area

DataLastCell = Cells(Rows.Count, "H").End(xlUp).Row 'Get the last cell in column H
Range("B4:H" & DataLastCell).Select  'Select Data range from B4 to the last cell in Column H

'******** Establish the Sort column first and last data points.
'
Range("E4").Select 'Get to first cell of sort Column (Putting 'E4')
SortRngStart = ActiveCell.Address 'Get the Cell address of the first cell of the data sort Column
SortRngEnd = Range("E" & ActiveSheet.Rows.Count).End(xlUp).Row  'Find the last row containing data or formats in column E
Range("E4:E" & SortRngEnd).Select  'Select Range from E4 to the last cell in column E
SortRngEnd = ActiveCell.Address


'******** Start the sort by specifying sort area and columns

ActiveWorkbook.Worksheets("MonthlyMedal").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("MonthlyMedal").Sort.SortFields.Add _
Key:=Range(SortRngStart & ":" & SortRngEnd), SortOn:=xlSortOnValues, Order:=xlAscending, _
       DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("MonthlyMedal").Sort
.SetRange Range("B4:H" & DataLastCell)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

  Application.ScreenUpdating = screenUpdateState

  ActiveSheet.Protect Password:="xxxx", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Code is identical for both sheets in the workbook.
Furthermore in Fig 1 above if the columns are empty, I get an error and the code terminates with completley the wrong range selected ?
I'm wondering whether my worksheet in fig 1 may be corrupted, and how could I check it and clean it up.
Has anyone an idea?

 

[GWteB]

I went a little bit more thoroug through this thread to get an impression of what you've got so far.
The Dropdown (on cell L5) invokes the main code, provided that the following code fragment is in the worksheet module of the MonthlyMedal worksheet.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
   Set KeyCells = Range("L5")
   Call MonthlyMedal
  
   End Sub

It seems to me it is not. I'll explain. The "main" Sub causes several changes on that sheet. Every individual change event fires the above sub Private Sub Worksheet_Change(ByVal Target As Range) which launches your "main" Sub, which fires ..... and so on, and so on .... an endless loop will be the result. You would have noticed, wouldn't you?
If I may ask, what's your goal with the code statement Set KeyCells = Range("L5") , because in this manner it's meaningless.

I have gone through the code this end and I think it is because the Dropdown list invokes the main code which includes protecting the sheet each time it is run - if that makes sense?

On entry of this Sub the protection of your MonthlyMedal sheet will be disabled and when the sub finishes protection will be set, so you start always with a protected sheet (unless your code was interrupted). You might consider to protect only the areas on your sheet you want to be untouched. To make that happen, select the cells that may be changed, open the Cell Properties dialog > tab Protection > uncheck Locked > apply/OK. Also add the following line to your code.

ActiveSheet.EnableSelection = xlUnlockedCells

Leading on from this, is that I am using dynamic sort code for the columns to sort them individually - its code I always use for sorting columns that may change length. The code is sheet based of course but all of a sudden there is an element of the execution that is different from all my other sheets that I have been using it in.
After execution the sorted column remains selected. This has never happened before, to my knowledge. Below are snips of sorted columns from two sheets in the same workbook that have used the same code. One shows the column selected and the other shows the result where the column is not selected once the sort code has executed whether the column is populated or blank.

This issue occurs since you're using .Select code statements. Simply selecting another cell afterwards will do.

Furthermore in Fig 1 above if the columns are empty, I get an error and the code terminates with completley the wrong range selected ?

Such an issue may occur because in you're code cells and ranges are approached using (concatenated) names (as String). In unforeseen situations such concatenations may resolve in unpredicted ranges. Furthermore you're declarations ar not explicit (e.g. dim Var instead of the prefered dim Var as Range or dim Var as String. This can also be the cause of unpredicted behavior or run-time errors.

I'm wondering whether my worksheet in fig 1 may be corrupted, and how could I check it and clean it up.

It could be corrupted, but that's hard to tell (and sometimes difficult to check). You might consider converting your data range into a Table (select desired range > Ribbon Start tab >Format as Table).
Sorting is easy done with a dropdown button, without the need of VBA and without worrying about data corruption.