Do Loop in Excel over 3 separate tabs that searches out "#NA" in column L and append Cell (,1) in that row into a different tab.

Hi Guys, I have 3 Excel tabs called, "Depos POS 17", "Loans POS 17" & "Depos POS 20", I want to create a Macro that Loops down Column L of each tab, looks for "#N/A", then copies  Cell A on that row and appends it into Column C of a tab called "Mapping" & Cell B on that row and appends it into Columns A of the tab called "Mapping". How would I do this?
JCutcliffeAsked:
Who is Participating?
 
NorieConnect With a Mentor VBA ExpertCommented:
Try this, it should have the right values going from source to destination.
Sub CopyToMappings()
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim rngDst As Range
Dim rngSrc As Range
Dim arrSheets As Variant
Dim i As Long
    Set wsDst = Sheets("Mappings")
    
    Set rngDst = wsDst.Range("C" & Rows.Count).End(xlUp).Offset(1)
    
    arrSheets = Array("DEPOS Pos 17", "LOANS Pos 17", "DEPOS Pos 20")
    
    For i = LBound(arrSheets) To UBound(arrSheets)
    
        Set wsSrc = Sheets(arrSheets(i))
        
        With wsSrc
        
            For Each rngSrc In .Range("L2", .Range("L" & Rows.Count).End(xlUp)).Cells
            
                If rngSrc.Text = "#N/A" Then
                    rngSrc.Offset(, -11).Copy rngDst              ' copy source A to destination C
                    rngSrc.Offset(, -10).Copy rngDst.Offset(, -2) ' copy source B to destination A
                    Set rngDst = rngDst.Offset(1)
                End If
                        
            Next rngSrc
            
        End With
        
    Next i
    
End Sub

Open in new window

1
 
Rob HensonFinance AnalystCommented:
Can you upload a sample file showing the source data and the expected results?
0
 
JCutcliffeAuthor Commented:
Hi Rob, I cannot as I am at work and Security systems do not allow me to do that. I need to Loop column "L" down to row 100 on 3 tabs at the same time, looks for an "#NA", then copy the Value in column A in that row to column C in the tab "Mapping". Any ideas?
0
Cloud Class® Course: Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

 
NorieVBA ExpertCommented:
Can you clarify which columns you want to copy to Mappings and where you want them copied to?

Also, would you want the sheet name the values are copied from to appear on the Mappings sheet?
0
 
Rob HensonFinance AnalystCommented:
OK, what about identifying which tab the data came from when copied to Mapping tab?
0
 
Rob HensonFinance AnalystCommented:
Source Column A to Mapping column C
Source Column B to Mapping column A

In addition:
Will mapping sheet already exist or does it need creating?
Will there be other sheets in the workbook or just the 3 specified? If only the 3 then we can apply the routine to all sheets except Mapping rather than specifying sheet names.
0
 
JCutcliffeAuthor Commented:
There are 3 tabs called "Depos POS 17", "Depos POS 20" & "Loans POS 17". Loop down Column L on all three tabs, all "#NA"s in Column L in those tabs, copy the value in column A of those rows and append the values to Column C in the tab "Mapping".
0
 
Rob HensonFinance AnalystCommented:
Please can you answer the questions rather than just repeating the requirement.
0
 
NorieVBA ExpertCommented:
This will loop through the three sheets and whenever #N/A is found in column L the value in column A will be appended to column C on the sheet 'Mappings'.
Sub CopyToMappings()
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim rngDst As Range
Dim rngSrc As Range
Dim arrSheets As Variant
Dim I As Long

    Set wsDst = Sheets("Mappings")
    
    Set rngDst = wsDst.Range("C2")
    
    arrSheets = Array("DEPOS Pos 17", "LOANS Pos 17", "DEPOS Pos 20")
    
    For I = LBound(arrSheets) To UBound(arrSheets)
    
        Set wsSrc = Sheets(arrSheets(I))
        Set rngSrc = wsSrc.Range("L2")
        
        Do
        
            If rngSrc.Text = "#N/A" Then
                rngSrc.Offset(, -11).Copy rngDst
                Set rngDst = rngDst.Offset(1)
            End If
            
            Set rngSrc = rngSrc.Offset(1)
            
        Loop Until rngSrc.Text = ""
        
    Next I
    
End Sub

Open in new window

0
 
Roy CoxGroup Finance ManagerCommented:
You don't need a Loop, use SpecialCells, e.g.
ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas, xlErrors).copy

Open in new window


Provide an example and I'll amend the code
0
 
Rob HensonFinance AnalystCommented:
Roy - won't that just copy the error cells? Author wants data from other columns on same row as error.  

Also, author can't upload a sample as per my earlier comment.
0
 
JCutcliffeAuthor Commented:
Hi Norie, your code is not looping down column L as there's data on every other row. Can you adjust it so it loops down to row 100 on each tab? Your code stops when there's an empty cell and this is wrong.

Set rngSrc = rngSrc.Offset(1)
           
  Loop Until rngSrc.Text = ""
0
 
Roy CoxGroup Finance ManagerCommented:
Rob

I hadn't read the question completely, but it could hide the rows then copy
0
 
NorieVBA ExpertCommented:
Try this.
Sub CopyToMappings()
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim rngDst As Range
Dim rngSrc As Range
Dim arrSheets As Variant
Dim I As Long
    Set wsDst = Sheets("Mappings")
    
    Set rngDst = wsDst.Range("C2")
    
    arrSheets = Array("DEPOS Pos 17", "LOANS Pos 17", "DEPOS Pos 20")
    
    For I = LBound(arrSheets) To UBound(arrSheets)
    
        Set wsSrc = Sheets(arrSheets(I))
        
        With wsSrc
        
            For Each rngSrc In .Range("L2", .Range("L" & Rows.Count).End(xlUp)).Cells
            
                If rngSrc.Text = "#N/A" Then
                    rngSrc.Offset(, -11).Copy rngDst
                    Set rngDst = rngDst.Offset(1)
                End If
                        
            Next rngSrc
            
        End With
        
    Next I
    
End Sub

Open in new window

0
 
Rob HensonFinance AnalystCommented:
Norie, author also wanted column B copied to Mapping column A; I presume you would achieve this with addition of:

Dim rngDst As Range
Dim rngDst2 As Range

and

Set rngDst = wsDst.Range("C2")
Set rngDst2 = wsDst.Range("A2")

and

If rngSrc.Text = "#N/A" Then
           rngSrc.Offset(, -11).Copy rngDst
           rngSrc.Offset(, -10).Copy rngDst2
           Set rngDst = rngDst.Offset(1)
           Set rngDst2 = rngDst2.Offset(1)
End If
0
 
Rob HensonFinance AnalystCommented:
See attached file with Norie's code embedded and amended as per my previous comment to include both columns of data to be copied.
Copy-mapping.xlsm
0
 
Roy CoxGroup Finance ManagerCommented:
If the data is in a tabular format then it could be filtered to remove errors and the specific column of data copied
0
 
NorieVBA ExpertCommented:
Rob

Originally I was going to post something that copied A & B but in the post prior to the one I posted the code in the author appeared to indicate it was only column A that was to be copied.

If that's not the case, and if there are any other changes needed, the code I posted should be easy to adapt.
0
 
JCutcliffeAuthor Commented:
Hi Rob, its both Columns A & B, Column A goes to Column C in the tab "Mapping" and Column B goes to Column A in the tab "Mapping"
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Please give this a try...

Sub ErrorLog()
Dim dws As Worksheet, ws As Worksheet
Dim shArr, sh
Dim errCell As Range, Rng As Range
Dim FirstAddress As String
Dim dlr As Long, r As Long

Application.ScreenUpdating = False

Set dws = Sheets("Mapping")
shArr = Array("DEPOS Pos 17", "LOANS Pos 17", "DEPOS Pos 20")

For Each sh In shArr
    Set ws = Sheets(sh)
    Set Rng = ws.Range("L:L")
    With Rng
        Set errCell = .Find(what:="#N/A", LookIn:=xlValues, lookat:=xlWhole)
        If Not errCell Is Nothing Then
            FirstAddress = errCell.Address
            Do
                dlr = dws.Range("A:C").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                r = errCell.Row
                ws.Range("A" & r).Copy dws.Range("C" & dlr)
                ws.Range("B" & r).Copy dws.Range("A" & dlr)
                Set errCell = .FindNext(errCell)
            Loop While Not errCell Is Nothing And FirstAddress <> errCell.Address
        End If
    End With
    Set Rng = Nothing
    Set errCell = Nothing
    FirstAddress = ""
Next sh
Application.ScreenUpdating = True
End Sub

Open in new window

0
 
JCutcliffeAuthor Commented:
Hi Norie, the Loop in the Source tab is working now in your code. However, it does not append. It pastes it in the Range ("C3"). Should it not be rngDst = rngDst.End(xlDown).Offset (1)?

 Set rngDst = wsDst.Range("C2")
  Set rngDst = rngDst.Offset(1)
0
 
NorieVBA ExpertCommented:
In the code I posted I was setting the destination here to be C2 on 'Mappings'
10   Set rngDst = wsDst.Range("C2")

Open in new window

That was before clarification and that should be changed to this,
10 Set rngDst = wsDst.Range("C" & Rows.Count).End(xlUp).Offset(1)

Open in new window

so that the destination is in the next empty cell in column C on 'Mappings'
0
 
JCutcliffeAuthor Commented:
Hi Norie, thanks! It works! Now how do I add to the code to get the Values in column B in the Source tabs to go into Column A in the "Mapping" tab  ?
0
 
JCutcliffeAuthor Commented:
Superb!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.