View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
gootroots gootroots is offline
external usenet poster
 
Posts: 28
Default Expert eye needed

Hi

I need an experts eye to scan over the following code to pinpoint why it
fall over at the point

lngLastRow =

When this is fixed is there anywhere else that needs addressed that might
then cause it to fall over too.


Here is the compete code:

Option Explicit
Option Compare Text

Private Sub AddRow_Click()


Dim rng As Range
Dim lr As Long
Dim sh As Worksheet
Dim ws As Worksheet
Dim i As Integer
Dim FD As String 'find string
Dim Frow As Integer 'found row
Dim sel As String
Dim shname As String
Dim x As Long
Dim ingLastRow As Long

' remove filter
For x = 1 To Worksheets.Count
If Sheets(x).FilterMode Then
Sheets(x).ShowAllData
End If
Next

' insert value in last blank cell in "B"
If IsEmpty(Range("b9")) Then
MsgBox "No record found in B9.", vbInformation
Else
lngLastRow = Cells(Rows.Count, "B").End(xlUp).Row + 1

If lngLastRow <= 10 Then
Range("B10").Value = Range("B9").Value
Else
Cells(lngLastRow, "B").Value = Range("B9").Value
End If
End If


Application.ScreenUpdating = False

Set sh = ActiveSheet
shname = ActiveSheet.Name
FD = ActiveCell.Value
lr = sh.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = sh.Range("A11:H" & lr)
sel = Selection.Address
rng.Sort Range(sel), xlAscending

'Loop through the newly inserted row and copy formula from 1 cell above
Frow = Range("B:B").Find(FD, LookIn:=xlValues).Row
For i = 1 To 10 Step 2 'change to extend if Range grows.
Cells(Frow - 1, i).Copy Cells(Frow, i)
Next i

'Take new data and paste it on the Uses sheet.
For Each ws In ThisWorkbook.Worksheets
If Left((ws.Name), 4) = "Uses" And Not ws.Name = shname Then
Sheets(shname).Rows(Frow).Copy
ws.Cells(Frow, 1).Insert

Range("B10").Select
End If

Next ws

Application.ScreenUpdating = True

Application.CutCopyMode = False

End Sub

Much appreciate any help or suggestions.