VBA Help: Inserting rows and copying cells from another worksheet

T

tetreama

New Member
Joined
Apr 28, 2009
Messages
42
My code is using two worksheets. I want the code to read the offset number on tab A and insert the approrpriate rows. I then want it to read from a list of records on tab B and copy and paste data from Columns D and E when the ID Codes are matched (Column D in TAB A and Column B in TAB B)

I've pasted my code below. I get an error stating: 'Subscript out of range' at the point in my code where I want to "'Find applicable ID number in the list of IDs". Any ideas? Thanks.

The layout of Tab A and Tab B are as follows:

TAB A
ColumnA ColumnB ColumnC ColumnD Column E
Data Data Data ID Code Offset

TAB B

ColumnA ColumnB ColumnC ColumnD ColumnE
Data Range ID.code2 Offset Data Data


My Current Code
Sub FormatRM()
Dim Cell As Range
Set Cell = Sheets("RM Planning").Range("E4")
Do While Not IsEmpty(Cell)

If Cell > 1 Then

'Insert additional rows based on the offset amount

Range(Cell.Offset(1, 0), Cell.Offset(Cell.Value - 1, 0)).EntireRow.Insert

With Sheets("ID Library").Range("ID.code2")

'Find applicable ID number in the list of IDs

Cells.Find(What:=Cell.Offset(0, -1), After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

'Copy the required set of job plans for the asset

Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(Cell.Value - 1, 3)).Copy
Cell.Offset(0, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

End With

Range(Cell.Offset(0, -1), Cell.Offset(Cell.Value - 1, 0)).Columns.FillDown

End If

Set Cell = Cell.Offset(Cell.Value, 0)
Loop
End Sub
<!-- / message -->
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sort by date Sort by votes
Try this. Note the red period at the start.

.Cells.Find(What:=Cell.Offset(0, -1), After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
 
Upvote 0
If there isn't a match, you will get that error because you are trying to activate a cell that you didn't find.

Maybe try something like this. (This isn't tested.)
Code: 
Sub FormatRM()
    Dim Cell As Range, rFindID As Range
    
    Set Cell = Sheets("RM Planning").Range("E4")
    
    Do While Not IsEmpty(Cell)
    
        If Cell > 1 Then
        
            'Insert additional rows based on the offset amount
            
            Range(Cell.Offset(1, 0), Cell.Offset(Cell.Value - 1, 0)).EntireRow.Insert
            
            With Sheets("ID Library").Range("ID.code2")
            
                'Find applicable ID number in the list of IDs
                
                Set rFindID = .Cells.Find(What:=Cell.Offset(0, -1), After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt _
                :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False)
                
                'Copy the required set of job plans for the asset
                If Not rFindID Is Nothing Then
                    Range(rFindID.Offset(0, 2), rFindID.Offset(Cell.Value - 1, 3)).Copy
                    Cell.Offset(0, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                    Application.CutCopyMode = False
                Else
                    MsgBox "Couldn't find " & Cell.Value
                End If
                
            End With
            
            Range(Cell.Offset(0, -1), Cell.Offset(Cell.Value - 1, 0)).Columns.FillDown
        
        End If
        
        Set rFindID = Nothing
        Set Cell = Cell.Offset(Cell.Value, 0)
    Loop
End Sub
 
Upvote 0
I found one glitch with the my code. When the offset is 1, the code does not past the appropriate cells, only blank cells. The code works when the offset is great than 1. I haven't been able to make the corrections to the code above.
 
Upvote 0
By changing the code to read "If Cell >=1" as opposed to "If Cell =1", the code now returns the correct cells from Tab B, however there something wrong with the insertion of rows. When the code encounters an ID with an Offset of 1. It deletes the information in Columns D and E on Tab A for that record. Not sure if this will make sense to anyone. Thanks.

Sub FormatRM()
Dim Cell As Range
Set Cell = Sheets("RM Planning").Range("E5")
Do While Not IsEmpty(Cell)

If Cell >= 1 Then

'Insert additional rows based on the offset amount

Range(Cell.Offset(1, 0), Cell.Offset(Cell.Value - 1, 0)).EntireRow.Insert

With Sheets("ID Library").Range("ID.code2")

'Find applicable ID number in the list of IDs

Set rFindID = .Cells.Find(What:=Cell.Offset(0, -1), After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)

'Copy the required set of job plans for the asset
If Not rFindID Is Nothing Then
Range(rFindID.Offset(0, 2), rFindID.Offset(Cell.Value - 1, 4)).Copy
Cell.Offset(0, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False

Else
MsgBox "Couldn't find" & Cell.Value

End If

End With

Range(Cell.Offset(0, -1), Cell.Offset(Cell.Value - 1, 0)).Columns.FillDown

End If

Set rFindID = Nothing
Set Cell = Cell.Offset(Cell.Value, 0)
Loop
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question
VBA inserting formula's in cells not working
Replies
7
Views
322
Peter_SSs
Peter_SSs
M
  • Solved
Automatic table detection
2 3
Replies
22
Views
1K
NoSparks
N
weefatb0b
  • Solved
VBA-Sum Columns Ignoring Other sheets
2
Replies
10
Views
617
Joe4
Joe4
J
  • Question
Issues looping through excel data range when blank rows/cells are introduced.
Replies
6
Views
543
Skyybot
Skyybot
S
  • Question
VBA Help - Need listbox to scroll to top when opened
Replies
1
Views
330
rlv01
R

Forum statistics

Threads
1,215,009
Messages
6,122,674
Members
449,091
Latest member
peppernaut

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top