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?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

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
NorieAnalyst Assistant Commented:
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
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

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
NorieAnalyst Assistant Commented:
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
NorieAnalyst Assistant Commented:
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
NorieAnalyst Assistant Commented:
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
NorieAnalyst Assistant Commented:
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
NorieAnalyst Assistant Commented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
JCutcliffeAuthor Commented:
Superb!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.