S
ste mac
Hi, this code should be checking a range on 'Datasheet' which starts
in B3...(3,2)
Please have a look at the code below, I have a feeling its
wrong but I am not sure...
Is this bit correct?
Set b1 = cell(1, 1)
Set b2 = cell(1, 2)
Set b3 = cell(1, 3)
Set b4 = cell(1, 4)
Set b5 = cell(1, 5)
or should it be
Set b1 = cell(2, 3)
Set b2 = cell(3, 3)
Set b3 = cell(4, 3)
Set b4 = cell(5, 3)
Set b5 = cell(6, 3)
Is it checking the correct range? I have this horrible feeling it
should be checking one cell to the right...
should it?
Option Explicit
Sub RebuildFULLhits()
Dim sheetname As String
Dim sheetnumber As Long
For sheetnumber = 1 To 56
sheetname = "S" & Format(sheetnumber, "##0")
Sheets(sheetname).Select
RebulidFULLlinehits
Next
Application.ScreenUpdating = False
End Sub
Sub RebulidFULLlinehits()
Dim xlrow As Long
Dim data1 As Long
Dim data2 As Long
Dim data3 As Long
Dim data4 As Long
Dim data5 As Long
Dim datatotal As Long
Dim b1 As Range
Dim b2 As Range
Dim b3 As Range
Dim b4 As Range
Dim b5 As Range
Dim rng As Range
Dim cell As Range
Dim sheetnumber As Long
With Worksheets("Datasheet")
Set rng = .Range("B3", .Range("B3").End(xlDown))
End With
Application.ScreenUpdating = False
For Each cell In rng
xlrow = 2
Set b1 = cell(1, 1)
Set b2 = cell(1, 2)
Set b3 = cell(1, 3)
Set b4 = cell(1, 4)
Set b5 = cell(1, 5)
Do While Not (ActiveSheet.Cells(xlrow, 1).Value = "")
If ActiveSheet.Cells(xlrow, 3).Value = b1 Then
ball1 = 1
Else: data1 = 0
End If
If ActiveSheet.Cells(xlrow, 4).Value = b2 Then
ball2 = 1
Else: data2 = 0
End If
If ActiveSheet.Cells(xlrow, 5).Value = b3 Then
ball3 = 1
Else: data3 = 0
End If
If ActiveSheet.Cells(xlrow, 6).Value = b4 Then
ball4 = 1
Else: data4 = 0
End If
If ActiveSheet.Cells(xlrow, 7).Value = b5 Then
data5 = 1
Else: data5 = 0
End If
balltotal = data1 + data2 + data3 + data4 + data5
If balltotal = 0 Then
ActiveSheet.Cells(xlrow, 8).Value = ActiveSheet.Cells(xlrow, 8).Value
+ 1
ElseIf balltotal = 1 Then
ActiveSheet.Cells(xlrow, 9).Value = ActiveSheet.Cells(xlrow, 9).Value
+ 1
ElseIf balltotal = 2 Then
ActiveSheet.Cells(xlrow, 10).Value = ActiveSheet.Cells(xlrow,
10).Value + 1
ElseIf balltotal = 3 Then
ActiveSheet.Cells(xlrow, 11).Value = ActiveSheet.Cells(xlrow,
11).Value + 1
ElseIf balltotal = 4 Then
ActiveSheet.Cells(xlrow, 12).Value = ActiveSheet.Cells(xlrow,
12).Value + 1
ElseIf balltotal = 5 Then
ActiveSheet.Cells(xlrow, 13).Value = ActiveSheet.Cells(xlrow,
13).Value + 1
End If
ActiveSheet.Cells(xlrow, 14).Value = ActiveSheet.Cells(xlrow,
13).Value + ActiveSheet.Cells(xlrow, 12).Value _
+ ActiveSheet.Cells(xlrow, 11).Value
xlrow = xlrow + 1
Application.StatusBar = xlrow & " " & Activesheet.name
Loop
Application.StatusBar = False
Next cell
End Sub
in B3...(3,2)
Please have a look at the code below, I have a feeling its
wrong but I am not sure...
Is this bit correct?
Set b1 = cell(1, 1)
Set b2 = cell(1, 2)
Set b3 = cell(1, 3)
Set b4 = cell(1, 4)
Set b5 = cell(1, 5)
or should it be
Set b1 = cell(2, 3)
Set b2 = cell(3, 3)
Set b3 = cell(4, 3)
Set b4 = cell(5, 3)
Set b5 = cell(6, 3)
Is it checking the correct range? I have this horrible feeling it
should be checking one cell to the right...
should it?
Option Explicit
Sub RebuildFULLhits()
Dim sheetname As String
Dim sheetnumber As Long
For sheetnumber = 1 To 56
sheetname = "S" & Format(sheetnumber, "##0")
Sheets(sheetname).Select
RebulidFULLlinehits
Next
Application.ScreenUpdating = False
End Sub
Sub RebulidFULLlinehits()
Dim xlrow As Long
Dim data1 As Long
Dim data2 As Long
Dim data3 As Long
Dim data4 As Long
Dim data5 As Long
Dim datatotal As Long
Dim b1 As Range
Dim b2 As Range
Dim b3 As Range
Dim b4 As Range
Dim b5 As Range
Dim rng As Range
Dim cell As Range
Dim sheetnumber As Long
With Worksheets("Datasheet")
Set rng = .Range("B3", .Range("B3").End(xlDown))
End With
Application.ScreenUpdating = False
For Each cell In rng
xlrow = 2
Set b1 = cell(1, 1)
Set b2 = cell(1, 2)
Set b3 = cell(1, 3)
Set b4 = cell(1, 4)
Set b5 = cell(1, 5)
Do While Not (ActiveSheet.Cells(xlrow, 1).Value = "")
If ActiveSheet.Cells(xlrow, 3).Value = b1 Then
ball1 = 1
Else: data1 = 0
End If
If ActiveSheet.Cells(xlrow, 4).Value = b2 Then
ball2 = 1
Else: data2 = 0
End If
If ActiveSheet.Cells(xlrow, 5).Value = b3 Then
ball3 = 1
Else: data3 = 0
End If
If ActiveSheet.Cells(xlrow, 6).Value = b4 Then
ball4 = 1
Else: data4 = 0
End If
If ActiveSheet.Cells(xlrow, 7).Value = b5 Then
data5 = 1
Else: data5 = 0
End If
balltotal = data1 + data2 + data3 + data4 + data5
If balltotal = 0 Then
ActiveSheet.Cells(xlrow, 8).Value = ActiveSheet.Cells(xlrow, 8).Value
+ 1
ElseIf balltotal = 1 Then
ActiveSheet.Cells(xlrow, 9).Value = ActiveSheet.Cells(xlrow, 9).Value
+ 1
ElseIf balltotal = 2 Then
ActiveSheet.Cells(xlrow, 10).Value = ActiveSheet.Cells(xlrow,
10).Value + 1
ElseIf balltotal = 3 Then
ActiveSheet.Cells(xlrow, 11).Value = ActiveSheet.Cells(xlrow,
11).Value + 1
ElseIf balltotal = 4 Then
ActiveSheet.Cells(xlrow, 12).Value = ActiveSheet.Cells(xlrow,
12).Value + 1
ElseIf balltotal = 5 Then
ActiveSheet.Cells(xlrow, 13).Value = ActiveSheet.Cells(xlrow,
13).Value + 1
End If
ActiveSheet.Cells(xlrow, 14).Value = ActiveSheet.Cells(xlrow,
13).Value + ActiveSheet.Cells(xlrow, 12).Value _
+ ActiveSheet.Cells(xlrow, 11).Value
xlrow = xlrow + 1
Application.StatusBar = xlrow & " " & Activesheet.name
Loop
Application.StatusBar = False
Next cell
End Sub