Add a criteria to VBA Code

H

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
1,501
Office Version
  1. 2016
Platform
  1. Windows
Hello Friends,

I am using the below code which works just fine copying data from a worksheet to another
I just want to add 2 criterias after the below compulsory part of the code

COMPULORY PART
For Each cell In rng13
If cell.Value = "In Process" Then

Criteria 1
if cell ("A1").value = 2 then
For Each cell In rng4
If cell.Value like "*Lomotex*" Then

Criteria 2
if cell ("A1").value = 3 then
For Each cell In rng4
If (Not cell.Value Like "*Lomotex*") Then

If range("A1").value is neither 2 nor 3 then the below code to work only with the COMPULSORY PART as it is doing right now

VBA Code: 
Sub ro_all()

Set rng1 = Names("orders_po").RefersToRange
Set rng2 = Names("orders_ref").RefersToRange
Set rng3 = Names("orders_po_date").RefersToRange
Set rng4 = Names("orders_customer").RefersToRange
Set rng5 = Names("orders_supplier").RefersToRange
Set rng6 = Names("orders_article").RefersToRange
Set rng7 = Names("orders_quality").RefersToRange
Set rng8 = Names("orders_size").RefersToRange
Set rng9 = Names("orders_quantity").RefersToRange
Set rng10 = Names("orders_unit").RefersToRange
Set rng11 = Names("orders_po_shipment_date").RefersToRange
Set rng12 = Names("orders_remarks").RefersToRange
Set rng13 = Names("orders_status").RefersToRange

destRow = 4
    
For Each cell In rng13
        If cell.Value = "In Process" Then

ActiveSheet.Cells(destRow, 1).Value = rng1.Cells(cell.Row - rng1.Row + 1, 1).Value
ActiveSheet.Cells(destRow, 2).Value = rng2.Cells(cell.Row - rng2.Row + 1, 1).Value
ActiveSheet.Cells(destRow, 3).Value = rng3.Cells(cell.Row - rng3.Row + 1, 1).Value
ActiveSheet.Cells(destRow, 4).Value = rng4.Cells(cell.Row - rng4.Row + 1, 1).Value
ActiveSheet.Cells(destRow, 5).Value = rng5.Cells(cell.Row - rng5.Row + 1, 1).Value
ActiveSheet.Cells(destRow, 6).Value = rng6.Cells(cell.Row - rng6.Row + 1, 1).Value
ActiveSheet.Cells(destRow, 7).Value = rng7.Cells(cell.Row - rng7.Row + 1, 1).Value
ActiveSheet.Cells(destRow, 8).Value = rng8.Cells(cell.Row - rng8.Row + 1, 1).Value
ActiveSheet.Cells(destRow, 9).Value = rng9.Cells(cell.Row - rng9.Row + 1, 1).Value
ActiveSheet.Cells(destRow, 10).Value = rng10.Cells(cell.Row - rng10.Row + 1, 1).Value
ActiveSheet.Cells(destRow, 11).Value = rng11.Cells(cell.Row - rng11.Row + 1, 1).Value
ActiveSheet.Cells(destRow, 13).Value = rng12.Cells(cell.Row - rng12.Row + 1, 1).Value

destRow = destRow + 1 ' Move to the next row in the destination sheet
        End If
    Next cell

End Sub

Regards,

Humayun
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
try:
VBA Code: 
Sub ro_all()
    Dim rng As Range
    Set rng1 = Names("orders_po").RefersToRange
    Set rng2 = Names("orders_ref").RefersToRange
    Set rng3 = Names("orders_po_date").RefersToRange
    Set rng4 = Names("orders_customer").RefersToRange
    Set rng5 = Names("orders_supplier").RefersToRange
    Set rng6 = Names("orders_article").RefersToRange
    Set rng7 = Names("orders_quality").RefersToRange
    Set rng8 = Names("orders_size").RefersToRange
    Set rng9 = Names("orders_quantity").RefersToRange
    Set rng10 = Names("orders_unit").RefersToRange
    Set rng11 = Names("orders_po_shipment_date").RefersToRange
    Set rng12 = Names("orders_remarks").RefersToRange
    Set rng13 = Names("orders_status").RefersToRange
    destRow = 4
    With ActiveSheet
        Set cla = .Range("A1")
        If cla = 2 Or cla = 3 Then Set rng = rng4 Else Set rng = rng13
        For Each cell In rng
            Select Case cla.Value
                Case 2
                    If cell.Value Like "*Lomotex*" Then
S0:
                        .Cells(destRow, 1).Value = rng1.Cells(cell.Row - rng1.Row + 1, 1).Value
                        .Cells(destRow, 2).Value = rng2.Cells(cell.Row - rng2.Row + 1, 1).Value
                        .Cells(destRow, 3).Value = rng3.Cells(cell.Row - rng3.Row + 1, 1).Value
                        .Cells(destRow, 4).Value = rng4.Cells(cell.Row - rng4.Row + 1, 1).Value
                        .Cells(destRow, 5).Value = rng5.Cells(cell.Row - rng5.Row + 1, 1).Value
                        .Cells(destRow, 6).Value = rng6.Cells(cell.Row - rng6.Row + 1, 1).Value
                        .Cells(destRow, 7).Value = rng7.Cells(cell.Row - rng7.Row + 1, 1).Value
                        .Cells(destRow, 8).Value = rng8.Cells(cell.Row - rng8.Row + 1, 1).Value
                        .Cells(destRow, 9).Value = rng9.Cells(cell.Row - rng9.Row + 1, 1).Value
                        .Cells(destRow, 10).Value = rng10.Cells(cell.Row - rng10.Row + 1, 1).Value
                        .Cells(destRow, 11).Value = rng11.Cells(cell.Row - rng11.Row + 1, 1).Value
                        .Cells(destRow, 13).Value = rng12.Cells(cell.Row - rng12.Row + 1, 1).Value
                        destRow = destRow + 1 ' Move to the next row in the destination sheet
                    End If
                Case 3
                    If Not cell.Value Like "*Lomotex*" Then GoTo S0
                Case Else
                    If cell.Value = "In Process" Then GoTo S0
            End Select
        Next cell
    End With
End Sub
 
Upvote 0
Dear Eiloken,

Thanks for providing the code but it is not working OK
For Criteria 1 & 2 both
If range("A1").value=2 or 3 then it is ignoring the below compulsory part

COMPULORY PART
For Each cell In rng13
If cell.Value = "In Process" Then

What I want the code to do is
1) if range("A1").value = 2 then consider Criteria 1 along with the compulsory part
2) if range("A1").value = 3 then consider Criteria 2 along with the compulsory part

The compulsory part should always be there
 
Upvote 0
hrayani said:
Dear Eiloken,

Thanks for providing the code but it is not working OK
For Criteria 1 & 2 both
If range("A1").value=2 or 3 then it is ignoring the below compulsory part

COMPULORY PART
For Each cell In rng13
If cell.Value = "In Process" Then

What I want the code to do is
1) if range("A1").value = 2 then consider Criteria 1 along with the compulsory part
2) if range("A1").value = 3 then consider Criteria 2 along with the compulsory part

The compulsory part should always be there
Click to expand...
what exactly is your [cell("A1")]? i don't know where is it came from then i assign it in activesheet, if it not in the same sheet as activesheet then macro will not work property, you can change it to your cell, you don' t show any data so i can not test the code.
 
Upvote 0
eiloken said:
what exactly is your [cell("A1")]? i don't know where is it came from then i assign it in activesheet, if it not in the same sheet as activesheet then macro will not work property, you can change it to your cell, you don' t show any data so i can not test the code.
Click to expand...
Cell A1 is in the same sheet

Cell A1 with either be blank or contain value 2 or 3 - nothing else
what I want the code to do is after checking the mandatory part below
MANDATORY PART
For Each cell In rng13
If cell.Value = "In Process" Then

look at range A1. if it contains value 2 then besides mandatory part consider criteria 1 also before copying
look at range A1. if it contains value 3 then besides mandatory part consider criteria 2 also before copying

if range A1 is neither 2 nor 3 then only consider the mandatory part & continue copying
 
Upvote 0
so what happened when it meet the condition 1 or 2? i saw that it will continues loop through each cells in rng4 but i saw no compare to the cell in rng13?
 
Upvote 0
eiloken said:
so what happened when it meet the condition 1 or 2? i saw that it will continues loop through each cells in rng4 but i saw no compare to the cell in rng13?
Click to expand...
yes exactly it should not skip the mandatory part. But, it does at the moment

it should loop through each cell in rng13 & then before copying look at cell A1.
if cell A1 = 2 then after looping through each cell in rng13, it should loop through each cell in rng4
 
Upvote 0
hrayani said:
yes exactly it should not skip the mandatory part. But, it does at the moment

it should loop through each cell in rng13 & then before copying look at cell A1.
if cell A1 = 2 then after looping through each cell in rng13, it should loop through each cell in rng4
Click to expand...
i can't saw the relation between the cell in rng13 with the cell in rng4, as i understood, when you loop through each cell in rng13, and its value = "In Process" then we will consider value in A1, if it is 2 then loop through each cell in rng4 (this cell is different with the cell in rng13), if it like "*Lomotex*" then do then do the "COMPULSORY PART"?:
VBA Code: 
Sub ro_all()
    Dim rng As Range
    Set rng1 = Names("orders_po").RefersToRange
    Set rng2 = Names("orders_ref").RefersToRange
    Set rng3 = Names("orders_po_date").RefersToRange
    Set rng4 = Names("orders_customer").RefersToRange
    Set rng5 = Names("orders_supplier").RefersToRange
    Set rng6 = Names("orders_article").RefersToRange
    Set rng7 = Names("orders_quality").RefersToRange
    Set rng8 = Names("orders_size").RefersToRange
    Set rng9 = Names("orders_quantity").RefersToRange
    Set rng10 = Names("orders_unit").RefersToRange
    Set rng11 = Names("orders_po_shipment_date").RefersToRange
    Set rng12 = Names("orders_remarks").RefersToRange
    Set rng13 = Names("orders_status").RefersToRange
    destRow = 4
    With ActiveSheet
        Set cla = .Range("A1")
        For Each cell In rng
            If cell.Value = "In Process" Then
                If Not cla.Value = 2 And Not cla.Value = 3 Then
S0:
                    .Cells(destRow, 1).Value = rng1.Cells(cell.Row - rng1.Row + 1, 1).Value
                    .Cells(destRow, 2).Value = rng2.Cells(cell.Row - rng2.Row + 1, 1).Value
                    .Cells(destRow, 3).Value = rng3.Cells(cell.Row - rng3.Row + 1, 1).Value
                    .Cells(destRow, 4).Value = rng4.Cells(cell.Row - rng4.Row + 1, 1).Value
                    .Cells(destRow, 5).Value = rng5.Cells(cell.Row - rng5.Row + 1, 1).Value
                    .Cells(destRow, 6).Value = rng6.Cells(cell.Row - rng6.Row + 1, 1).Value
                    .Cells(destRow, 7).Value = rng7.Cells(cell.Row - rng7.Row + 1, 1).Value
                    .Cells(destRow, 8).Value = rng8.Cells(cell.Row - rng8.Row + 1, 1).Value
                    .Cells(destRow, 9).Value = rng9.Cells(cell.Row - rng9.Row + 1, 1).Value
                    .Cells(destRow, 10).Value = rng10.Cells(cell.Row - rng10.Row + 1, 1).Value
                    .Cells(destRow, 11).Value = rng11.Cells(cell.Row - rng11.Row + 1, 1).Value
                    .Cells(destRow, 13).Value = rng12.Cells(cell.Row - rng12.Row + 1, 1).Value
                    destRow = destRow + 1 ' Move to the next row in the destination sheet
                Else
                    For Each cll In rng4
                        If cla.Value = 2 Then
                            If cll.Value Like "*Lomotex*" Then GoTo S0
                        Else
                            If Not cll.Value Like "*Lomotex*" Then GoTo S0
                        End If
                    Next cll
                End If
            End If
        Next cell
    End With
End Sub
 
Upvote 0
it's till not working as desired
still ignoring the rng4 criterias even if cell A2 = 2 or 3

I guess we should leave it here - as I have done a work around to solve it i.e. deleting the undesired rows at the end of the code

Many thanks for your time & effort
I appreciate!
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
Code to Add Data From UserForm In Row Above or Below Based on Criteria
Replies
1
Views
234
amoverton2
A
S
  • Solved
Copy hyperlinks from one table column to another. The columns are identical
Replies
2
Views
93
sspatriots
S
S
  • Question
VBA Code hangs on Outlook Send?
Replies
2
Views
376
shophoney
S
P
  • Solved
Macro hiding all cells
Replies
3
Views
437
Peter_SSs
Peter_SSs
JeffGrant
  • Solved
VBA Code used twice, keeps table formatting on one sheet, but not on the other
Replies
4
Views
250
smozgur
smozgur

Forum statistics

Threads
1,215,411
Messages
6,124,759
Members
449,187
Latest member
hermansoa

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