suddenflash
05-08-2012, 01:42 PM
Someway I get an error massage in this code. I have marked this row as x place.
Cannot figure out why is that so.
Can you advise me please
Sub otsibrh()
Dim rhsheet As Worksheet
Dim muutuja As Worksheet
Dim algmaterjal As Worksheet
Dim FIRMAD As Worksheet
Dim keskmine As Double
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim summa As Double
Dim otsi As Range
Dim rida As String
Dim Cat1
Dim kas As Boolean
i = 1
j = 1
k = 1
summa = 0
keskmine = 0
Set rhsheet = Sheets("Rhsheet")
Set algmaterjal = Sheets("algmaterjal")
Set Apsheet = Sheets("Apsheet")
Set FIRMAD = Sheets("FIRMAD")
' primary loop for searshing necessary letter combo
Do While algmaterjal.Cells(i, 2) <> 0
rida = " Rh"
Set otsi = algmaterjal.Cells(i, 2).Find(rida, MatchCase:=False)
If Not otsi Is Nothing Then
algmaterjal.Cells(i, 10) = "leidsin"
Cat1 = algmaterjal.Rows(i).Copy
rhsheet.Rows(j).Insert Shift:=xlDown ', CopyOrigin:=xlFormatFromLeftOrAbove
j = j + 1
End If
i = i + 1
Loop ' end of primary loop
j = 1
i = 1
Do While FIRMAD.Cells(i, 1) <> 0
FIRMAD.Cells(i, 13).Value = i
j = 1
Do While rhsheet.Cells(j, 2) <> 0
rhsheet.Cells(j, 7).Value = j
Set otsi = rhsheet.Cells(j, 2).Find(FIRMAD.Cells(i, 1), MatchCase:=False)
If Not otsi Is Nothing Then
rhsheet.Cells(j, 11) = FIRMAD.Cells(i, 1)
rhsheet.Cells(j, 12) = "SAMA I"
End If
j = j + 1
Loop
i = i + 1
Loop
j = 2
Do While rhsheet.Cells(j, 2) <> 0
summa = summa + rhsheet.Cells(j, 1).Value
rhsheet.Cells(j, 13) = rhsheet.Cells(j, 1).Value
rhsheet.Cells(j, 14) = summa
rhsheet.Cells(j, 15) = k
k = k + 1
If rhsheet.Cells(j, 11) <> rhsheet.Cells(j + 1, 11) Then
If j > 2 Then
keskmine = rhsheet.Cells(j - 1, 14) / rhsheet.Cells(j - 1, 15) ' X PLACE
rhsheet.Cells(j + 2, 15).Value = keskmine
rhsheet.Cells(j + 2, 14).Value = "keskmine"
End If
summa = 0
rhsheet.Rows(j + 1).Insert Shift:=xlDown
rhsheet.Rows(j + 1).Insert Shift:=xlDown
rhsheet.Rows(j + 1).Insert Shift:=xlDown
rhsheet.Cells(j + 1, 2) = 0
j = j + 3
k = 1
End If
j = j + 1
Loop
i = 1
j = 1
End Sub
Suddenflash
Cannot figure out why is that so.
Can you advise me please
Sub otsibrh()
Dim rhsheet As Worksheet
Dim muutuja As Worksheet
Dim algmaterjal As Worksheet
Dim FIRMAD As Worksheet
Dim keskmine As Double
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim summa As Double
Dim otsi As Range
Dim rida As String
Dim Cat1
Dim kas As Boolean
i = 1
j = 1
k = 1
summa = 0
keskmine = 0
Set rhsheet = Sheets("Rhsheet")
Set algmaterjal = Sheets("algmaterjal")
Set Apsheet = Sheets("Apsheet")
Set FIRMAD = Sheets("FIRMAD")
' primary loop for searshing necessary letter combo
Do While algmaterjal.Cells(i, 2) <> 0
rida = " Rh"
Set otsi = algmaterjal.Cells(i, 2).Find(rida, MatchCase:=False)
If Not otsi Is Nothing Then
algmaterjal.Cells(i, 10) = "leidsin"
Cat1 = algmaterjal.Rows(i).Copy
rhsheet.Rows(j).Insert Shift:=xlDown ', CopyOrigin:=xlFormatFromLeftOrAbove
j = j + 1
End If
i = i + 1
Loop ' end of primary loop
j = 1
i = 1
Do While FIRMAD.Cells(i, 1) <> 0
FIRMAD.Cells(i, 13).Value = i
j = 1
Do While rhsheet.Cells(j, 2) <> 0
rhsheet.Cells(j, 7).Value = j
Set otsi = rhsheet.Cells(j, 2).Find(FIRMAD.Cells(i, 1), MatchCase:=False)
If Not otsi Is Nothing Then
rhsheet.Cells(j, 11) = FIRMAD.Cells(i, 1)
rhsheet.Cells(j, 12) = "SAMA I"
End If
j = j + 1
Loop
i = i + 1
Loop
j = 2
Do While rhsheet.Cells(j, 2) <> 0
summa = summa + rhsheet.Cells(j, 1).Value
rhsheet.Cells(j, 13) = rhsheet.Cells(j, 1).Value
rhsheet.Cells(j, 14) = summa
rhsheet.Cells(j, 15) = k
k = k + 1
If rhsheet.Cells(j, 11) <> rhsheet.Cells(j + 1, 11) Then
If j > 2 Then
keskmine = rhsheet.Cells(j - 1, 14) / rhsheet.Cells(j - 1, 15) ' X PLACE
rhsheet.Cells(j + 2, 15).Value = keskmine
rhsheet.Cells(j + 2, 14).Value = "keskmine"
End If
summa = 0
rhsheet.Rows(j + 1).Insert Shift:=xlDown
rhsheet.Rows(j + 1).Insert Shift:=xlDown
rhsheet.Rows(j + 1).Insert Shift:=xlDown
rhsheet.Cells(j + 1, 2) = 0
j = j + 3
k = 1
End If
j = j + 1
Loop
i = 1
j = 1
End Sub
Suddenflash