Copying Data Based on Value in Column Using VBA

N

nryan

Board Regular
Joined
Apr 3, 2015
Messages
61
Hello,

I posted a thread earlier on this particular project I'm working on. Most issues have been solved and the program is sort of working. It's not encountering errors that stop the macro like before. The macro runs but i think the issue now is with the If-Then-ElseIf-Then-Else statement (see code below).

Background:

This macro copies cells from another workbook (I'll call it Copy workbook for future reference) based on 3 string values in column "E" which are "Vertical, "Angle", and "n/a". It Then pastes cells into the workbook with the macro (call it Paste workbook). I'll explain with an example below. (Sorry about the formatting. Many columns are blank because their data isn't relevant to the example.)

Copy from the Copy Workbook:
Column A B C D ...... E ........... K ...... L
Row 1 (Headers)
Row 2 .............. "Vertical" ... 33.3 ... 3.3
Row 3 ................ "Angle" .... 22.2 ... 2.2
Row 4 ..................."n/a" ..... 11.1 ... 1.1

Paste to the Paste Workbook:
Column A B C .... D ...... E ........ I ....... J ........ N ....... O
Row 1 (Headers)
Row 2 (Sub Headers)
Row 3 ............ 33.3 ... 3.3 ..... 22.2 ... 2.2 ..... 11.1 ... 1.1

If column E in the Copy Workbook says "Vertical" the data is pasted to columns D & E in the Paste Workbook. If it's "Angle" the data is pasted to columns I & J. If it's "n/a" the data is pasted to columns N & O. I hope that's clear.

Here is the code:

Code: 
Option Explicit

Sub GetData()

Dim wsPasteTo As Worksheet, wbDATA As Workbook
Dim NextRow As Long, LastRow As Long, i As Long

Set wsPasteTo = ThisWorkbook.Sheets("ACP")
NextRow = wsPasteTo.Range("A" & Rows.Count).End(xlUp).Row + 2

Set wbDATA = Workbooks.Open("\\cmicro.com\Shares\Amb\Amb-Probes\DataLogs\CQS-03-033-2012 Coax Shelf Cut Log R2.6.xlsm", ReadOnly:=True)
Application.ScreenUpdating = False

    With wbDATA.Sheets("ACP")
         
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        
        For i = 2 To LastRow
            
            If Cells(i, "E") = "Angle" Then
                .Range("K2:L" & LastRow).Copy
                wsPasteTo.Range("I" & NextRow).PasteSpecial xlPasteValues
            
            ElseIf Cells(i, "E") = "Vertical" Then
                .Range("K2:L" & LastRow).Copy
                wsPasteTo.Range("D" & NextRow).PasteSpecial xlPasteValues
            
            Else
                .Range("K2:L" & LastRow).Copy
                wsPasteTo.Range("N" & NextRow).PasteSpecial xlPasteValues
            
            End If
            
        Next i
        
    End With

Application.ScreenUpdating = True
wbDATA.Close False

End Sub

The Issue:

The issue is that ALL data is being pasted to columns N & O, which should only have "n/a" data. I went through debug mode and found that the first two If and ElseIf lines of code are being skipped so everything goes to the Else statement at the end, which of course pastes all the data into columns N & O. I guess the macro isn't noticing the string values "Vertical" and "Angle" in column E in the Copy Workbook? The Copy Workbook uses data validation in column E so the user recording data must select between the 3 options ("Vertical", "Angle", and "n/a") in a drop down list. I checked out column E in the Copy Workbook and there are no issue with spelling/capitalization. Maybe the fix is easy and I'm not seeing it.

Thanks for your help. It's all been great so far.
-Nick
 
Last edited:

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Sort by date Sort by votes
You are missing some periods in front of the Cells inside your With statement. Those will revert to whatever the active sheet is at run time and could be your problem.
With wbDATA.Sheets("ACP")

LastRow = .Range("A" & .Rows.Count).End(xlUp).Row

For i = 2 To LastRow

If Cells(i, "E") = "Angle" Then
.Range("K2:L" & LastRow).Copy
wsPasteTo.Range("I" & NextRow).PasteSpecial xlPasteValues

ElseIf Cells(i, "E") = "Vertical" Then
.Range("K2:L" & LastRow).Copy
wsPasteTo.Range("D" & NextRow).PasteSpecial xlPasteValues
Click to expand...
 
Upvote 0
Hi JLGWhiz,

Thanks for your reply. That helps but something else is happening now. Somehow that macro is not distinguishing between "Vertical" data and "Angle" data. There is no "n/a" data right now (that's a rare scenario). All data from Copy workbook is being pasted into columns D & E and I & J. i tried to fix that using Application.CutCopyMode = False, but that didn't work. Here's the updated code:

Code: 
Set wsPasteTo = ThisWorkbook.Sheets("ACP")NextRow = wsPasteTo.Range("A" & Rows.Count).End(xlUp).Row + 2


Set wbDATA = Workbooks.Open("\\cmicro.com\Shares\Amb\Amb-Probes\DataLogs\CQS-03-033-2012 Coax Shelf Cut Log R2.6.xlsm", ReadOnly:=True)
Application.ScreenUpdating = False


    With wbDATA.Sheets("ACP")
         
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        
        For i = 2 To LastRow
            
            If .Cells(i, "E") = "Angle" Then
                .Range("K2:L" & LastRow).Copy
                wsPasteTo.Range("I" & NextRow).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            
            ElseIf .Cells(i, "E") = "Vertical" Then
                .Range("K2:L" & LastRow).Copy
                wsPasteTo.Range("D" & NextRow).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            
            Else
                .Range("K2:L" & LastRow).Copy
                wsPasteTo.Range("N" & NextRow).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            
            End If
            
        Next i
        
    End With


Application.ScreenUpdating = True
wbDATA.Close False


End Sub

Any thoughts?
Thanks
 
Upvote 0
I am trying to understand the logic of the code. It appears to walk down Column E checking for one of the three criteria, Then no matter which criterion is found, it copies the same set of data K2:L&LastRow. It then pastes that data into wsPasteTo sheet D&NextRow for Vertical or I&NextRow for Angle. Since NextRow remains static, It would be overwriting with each iteration of the For...Next loop where either Angle or Vertical is found. I would think that you would want to either move your paste range downward or to the side of last block of data that was pasted on each iteration of the loop. But maybe that is what you want it to do.
 
Upvote 0
You are definitely right that I want to move the paste range downward of the last block. I try to do that with NextRow. You probably didn't see NextRow because when i posted the updated code I messed up and left some things out. Sorry about that man. Here it is again, the updated code:

Code: 
Option Explicit

Sub GetData()

Dim wsPasteTo As Worksheet, wbDATA As Workbook
Dim NextRow As Long, LastRow As Long, i As Long

Set wsPasteTo = ThisWorkbook.Sheets("ACP")
NextRow = wsPasteTo.Range("A" & Rows.Count).End(xlUp).Row + 2

Set wbDATA = Workbooks.Open("\\cmicro.com\Shares\Amb\Amb-Probes\DataLogs\CQS-03-033-2012 Coax Shelf Cut Log R2.6.xlsm", ReadOnly:=True)
Application.ScreenUpdating = False

    With wbDATA.Sheets("ACP")
         
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        
        For i = 2 To LastRow

            If .Cells(i, "E") = "Angle" Then
                .Range("K2:L" & LastRow).Copy
                wsPasteTo.Range("I" & NextRow).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
           
            ElseIf .Cells(i, "E") = "Vertical" Then
                .Range("K2:L" & LastRow).Copy
                wsPasteTo.Range("D" & NextRow).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
           
            Else
                .Range("K2:L" & LastRow).Copy
                wsPasteTo.Range("N" & NextRow).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
           
            End If
           
        Next i
       
    End With
 
Application.ScreenUpdating = True
wbDATA.Close False

End Sub

And again, somehow this macro isn't distinguishing between "Vertical" and "Angle". All data from Copy workbook is being pasted into columns D & E and I & J.
 
Upvote 0
Oh, yes, I saw it in the original code and it is in the same place in this code. The location of the line where you initialize the value of NextRow makes it static. In other words, it does not change value as the loop iterates, because it is outside the loop. But even if it was inside the loop, it is based on the last row of column A, and as best that I can tell, column A does not change during the process, so the value would still remain static. I would suggest that you add a statement to each of your if statements as follows
Code: 
    For i = 2 To LastRow
            If .Cells(i, "E") = "Angle" Then
                .Range("K2:L" & LastRow).Copy
                [COLOR="#B22222"][/COLOR][COLOR="#B22222"]If wsPasteTo.Range("I" & NextRow) = "" Then
                    wsPasteTo.Range("I" & NextRow).PasteSpecial xlPasteValues
                Else
                    wsPasteTo.Cells(Rows.Count, "I").End(xlUp)(2).PasteSpecial xlPasteValues
                End If[/COLOR]                Application.CutCopyMode = False
            ElseIf .Cells(i, "E") = "Vertical" Then
                .Range("K2:L" & LastRow).Copy
                [COLOR="#B22222"]If wsPasteTo.Range("D" & NextRow) = "" Then
                    wsPasteTo.Range("D" & NextRow).PasteSpecial xlPasteValues
                Else
                    wsPasteTo.Cells(Rows.Count, "D").End(xlUp)(2).PasteSpecial xlPasteValues
                End If[/COLOR]
                Application.CutCopyMode = False
            Else
                .Range("K2:L" & LastRow).Copy
               [COLOR="#B22222"] If wsPasteTo.Range("N" & NextRow) = "" Then
                    wsPasteTo.Range("N" & NextRow).PasteSpecial xlPasteValues
                Else
                    wsPasteTo.Cells(Rows.Count, "N").End(xlUp)(2).PasteSpecial xlPasteValues
                End If[/COLOR]                Application.CutCopyMode = False
            End If
    Next i
As I pointed out, you are copying the same bloc of data for Vertical as you are for Angle, but pasting it to different columns. It looks odd to me, but then I have no idea what the data is, so it could be perfectly logical.
 
Last edited:
Upvote 0
Thanks. I'll give this new code a shot. I too would think this was odd if i were you, so I'll try to describe the layout of my workbooks which might help:

In the Copy workbook all the data I want is in columns K & L. In the Paste workbook I want to paste the data into columns D & E (for Vertical), I & J (for Angle), and N & O (for everything else).

I don't want to paste over any data that is already in the Paste workbook and I want the data to be pasted into the cell downward from the last cell with data already in it. The reason why NextRow is based on the last row of column A is becasue column A holds the date stamp (the date the data was recorded) and i do eventually want to copy that data along with the serial number (in column C) and paste it into the Paste workbook. For NextRow I could use column E (which has "Vertical", "Angle", or "n/a" in it) instead of A and I'll probably do that.

If Next Row is static can it simply be moved inside the For Loop instead of adding the extra If statements? Or do those If statements ensure that I wont paste over any data already in the Paste workbook?
 
Last edited:
Upvote 0
I tried the code and it did something kind of strange. It gave me a lot more data than what was in the Copy workbook. It looked like the macro duplicated the data many, many times over. And the data was still the same in all columns.

A guy from stackoverflow suggested something that works okay but the issue is the data has gaps in it. Here's an example of what it looks like:

Copy from the Copy Workbook:
Column A B C D ...... E ........... K ...... L
Row 1 (Headers)
Row 2 .............. "Vertical" ... 33.3 ... 3.3
Row 3 ................ "Angle" .... 22.2 ... 2.2
Row 4 ..................."n/a" ..... 11.1 ... 1.1

Paste to the Paste Workbook:
Column A B C .... D ...... E ........ I ....... J ........ N ....... O
Row 1 (Headers)
Row 2 (Sub Headers)
Row 3 ............ 33.3 ... 3.3............................................
Row 4 .................................. 22.2 ... 2.2 .....................
Row 5 .........................................................11.1 ... 1.1

This isn't a critical problem, I can work with this, but having the data without gaps would save space and look nicer. Here's the code from stackoverflow:
Code: 
Option Explicit

Sub GetData()


Dim wsPasteTo As Worksheet, wbDATA As Workbook
Dim NextRow As Long, LastRow As Long, i As Long
Dim val, col


Set wsPasteTo = ThisWorkbook.Sheets("ACP")
NextRow = wsPasteTo.Range("A" & Rows.Count).End(xlUp).Row + 2


Set wbDATA = Workbooks.Open("\\cmicro.com\Shares\Amb\Amb-Probes\DataLogs\CQS-03-033-2012 Coax Shelf Cut Log R2.6.xlsm", ReadOnly:=True)
Application.ScreenUpdating = False


    With wbDATA.Sheets("ACP")
         
        LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
        
        For i = 2 To LastRow
            
            val = .Cells(i, "E").Value
            Select Case val
                Case "Angle": col = "I"
                Case "Vertical": col = "D"
                Case Else: col = "N"
            End Select
            
            wsPasteTo.Cells(NextRow, col).Resize(1, 2).Value = .Cells(i, "K").Resize(1, 2).Value
            
            NextRow = NextRow + 1
            
        Next i
        
    End With


Application.ScreenUpdating = True
wbDATA.Close False



End Sub

The one thing I don't get, and i'm waiting to hear back from the guy, is why he used the "K" column in the Paste workbook with the line of code:
Code: 
wsPasteTo.Cells(NextRow, col).Resize(1, 2).Value = .Cells(i, "K").Resize(1, 2).Value


Maybe I need a NextRow for all 3 types of data (Vertical, Angle, and n/a) because they will rarely have equal amounts of data points (e.g. 50 Vertical, 50 Angle, and 50 n/a).
 
Last edited:
Upvote 0
That was exactly it! I needed a NextRow for each data type. Here is the code that works for anyone needing a similar solution in the future.

Thanks again JLGWhiz for your help.

Code: 
Option Explicit

Sub GetData()


Dim wsPasteTo As Worksheet, wbDATA As Workbook
Dim NextRow As Long, LastRow As Long, i As Long
Dim val, col


Set wsPasteTo = ThisWorkbook.Sheets("ACP")


Set wbDATA = Workbooks.Open("\\cmicro.com\Shares\Amb\Amb-Probes\DataLogs\CQS-03-033-2012 Coax Shelf Cut Log R2.6.xlsm", ReadOnly:=True)
Application.ScreenUpdating = False


    With wbDATA.Sheets("ACP")
         
        LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
        
        For i = 2 To LastRow
            
            val = .Cells(i, "E").Value
            Select Case val
                Case "Angle": col = "I"
                    NextRow = wsPasteTo.Range("I" & Rows.Count).End(xlUp).Row + 1
                Case "Vertical": col = "D"
                    NextRow = wsPasteTo.Range("D" & Rows.Count).End(xlUp).Row + 1
                Case Else: col = "N"
                    NextRow = wsPasteTo.Range("N" & Rows.Count).End(xlUp).Row + 1
            End Select
            
            wsPasteTo.Cells(NextRow, col).Resize(1, 2).Value = .Cells(i, "K").Resize(1, 2).Value
            
        Next i
        
    End With


Application.ScreenUpdating = True
wbDATA.Close False


End Sub
 
Upvote 0
nryan said:
That was exactly it! I needed a NextRow for each data type. Here is the code that works for anyone needing a similar solution in the future.

Thanks again JLGWhiz for your help.

Code: 
Option Explicit

Sub GetData()


Dim wsPasteTo As Worksheet, wbDATA As Workbook
Dim NextRow As Long, LastRow As Long, i As Long
Dim val, col


Set wsPasteTo = ThisWorkbook.Sheets("ACP")


Set wbDATA = Workbooks.Open("\\cmicro.com\Shares\Amb\Amb-Probes\DataLogs\CQS-03-033-2012 Coax Shelf Cut Log R2.6.xlsm", ReadOnly:=True)
Application.ScreenUpdating = False


    With wbDATA.Sheets("ACP")
         
        LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
        
        For i = 2 To LastRow
            
            val = .Cells(i, "E").Value
            Select Case val
                Case "Angle": col = "I"
                    NextRow = wsPasteTo.Range("I" & Rows.Count).End(xlUp).Row + 1
                Case "Vertical": col = "D"
                    NextRow = wsPasteTo.Range("D" & Rows.Count).End(xlUp).Row + 1
                Case Else: col = "N"
                    NextRow = wsPasteTo.Range("N" & Rows.Count).End(xlUp).Row + 1
            End Select
            
            wsPasteTo.Cells(NextRow, col).Resize(1, 2).Value = .Cells(i, "K").Resize(1, 2).Value
            
        Next i
        
    End With


Application.ScreenUpdating = True
wbDATA.Close False


End Sub
Click to expand...
Youre Welcome,
Regards, JLG
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
VBA setting times of Copy & paste specific columns if the value is greater than 1
Replies
5
Views
301
JECYN
J
H
  • Solved
Macro to copy data based on specific criteria
Replies
6
Views
373
howard
H
C
  • Question
Copy and paste data through multiple workbooks
Replies
2
Views
218
CDaviess
C
K
  • Solved
Update to existing Move data macro
2
Replies
11
Views
367
Alex Blakenburg
A
J
  • Question
Copying and splitting data between sheets
Replies
3
Views
206
Jumparound
J

Forum statistics

Threads
1,215,444
Messages
6,124,893
Members
449,194
Latest member
JayEggleton

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