G
gootroots
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.
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.